theory Sample_PMF
  imports
    Standard_PMFs
    "HOL-Probability.Probability"
    "HOL-Library.Code_Target_Numeral"
    "Fisher_Yates.Fisher_Yates"
    "Random_BSTs.Random_BSTs"
    "Quick_Sort_Cost.Randomised_Quick_Sort"
    "List_Inversions.List_Inversions"
  keywords "estimate_pmf" :: "diag"
begin

subsection \<open>Implementing standard PMFs in terms of the primitives\<close>

text \<open>Uniform distribution of integers between 0 and \<open>n\<close> (inclusive):\<close>
definition integer_pmf :: "integer \<Rightarrow> integer pmf" where
  "integer_pmf n = pmf_of_set {0..n}"

declare [[code abort: integer_pmf]]

lemma nat_pmf_code [code]: "nat_pmf n = map_pmf nat_of_integer (integer_pmf (integer_of_nat n))"
  unfolding nat_pmf_def integer_pmf_def
proof (rule map_pmf_of_set_bij_betw [symmetric])
  show bij: "bij_betw nat_of_integer {0..integer_of_nat n} {0..n}"
    apply (intro bij_betwI[of _ _ _ integer_of_nat])
       apply (auto simp: integer_of_nat_eq_of_nat)
    apply (metis max_absorb2 of_nat_le_iff of_nat_of_integer)
    done

  have "0 \<in> {0..integer_of_nat n}"
    by (simp add: integer_of_nat_eq_of_nat)
  thus "{0..integer_of_nat n} \<noteq> {}"
    by blast

  show "finite {0..integer_of_nat n}"
    using bij_betw_finite[OF bij] by simp
qed

subsection \<open>Code printing and trusted code\<close>

text \<open>
  This is just a marker so that we can visually differentiate between a regular value
  and a value sampled from a distribution.
\<close>
definition SAMPLE :: "'a \<Rightarrow> 'a pmf" where "SAMPLE x = undefined"

notation (output) SAMPLE ("\<^bold>s\<^bold>a\<^bold>m\<^bold>p\<^bold>l\<^bold>e\<^bold>d \<^bold>v\<^bold>a\<^bold>l\<^bold>u\<^bold>e\<^bold>: _" [0])

definition termify_pmf :: "('a :: term_of \<Rightarrow> term) \<Rightarrow> 'a pmf \<Rightarrow> term" where
  "termify_pmf f x = Code_Evaluation.term_of x"

lemma term_of_pmf_code [code]:
  "Code_Evaluation.term_of (x :: 'a :: term_of pmf) =
     Code_Evaluation.App
       (Code_Evaluation.Const (STR ''Sample_PMF.SAMPLE'') (Typerep.typerep TYPE('a \<Rightarrow> 'a pmf)))
       (termify_pmf Code_Evaluation.term_of x)"
  by (simp add: term_of_anything)

code_printing
  type_constructor pmf \<rightharpoonup> (SML) "_ Pmf.pmf" and (Eval) "_ Pmf.pmf"
  | constant "return_pmf" \<rightharpoonup> (SML) "Pmf.return" and (Eval) "Pmf.return"
  | constant "bind_pmf" \<rightharpoonup> (SML) "Pmf.bind" and (Eval) "Pmf.bind"
  | constant "map_pmf" \<rightharpoonup> (SML) "Pmf.map" and (Eval) "Pmf.map"
  | constant "integer_pmf" \<rightharpoonup> (SML) "Pmf.integer" and (Eval) "Pmf.integer"
  | constant "termify_pmf" \<rightharpoonup> (SML) "Pmf.termify" and (Eval) "Pmf.termify"

declare [[code abort: termify_pmf]]

code_printing
  code_module "PMF" \<rightharpoonup> (SML) \<open>

signature PMF = sig

type 'a pmf
val return : 'a -> 'a pmf;
val bind : 'a pmf -> ('a -> 'b pmf) -> 'b pmf;
val map : ('a -> 'b) -> 'a pmf -> 'b pmf;
val integer : int -> int pmf;
val sample : 'a pmf -> 'a;
val termify : ('a -> 'term) -> 'a pmf -> 'term;

end

structure Pmf : PMF = struct

type 'a pmf = unit -> 'a;

fun return x = K x;

fun bind d f () = f (d ()) ();

fun integer n () = Random.random_range 0 n;

fun sample d = d ();

fun map f d () = f (d ());

fun termify term_of d = term_of (sample d)

end;

\<close>

subsection \<open>Estimation of mean and variance\<close>

class to_real =
  fixes to_real :: "'a \<Rightarrow> real"

instantiation real :: to_real
begin
definition "to_real x = (x :: real)"
instance ..
end

instantiation nat :: to_real
begin
definition "to_real x = (of_nat (x :: nat))"
instance ..
end

instantiation int :: to_real
begin
definition "to_real x = (of_int (x :: int))"
instance ..
end

instantiation rat :: to_real
begin
definition "to_real x = (of_rat (x :: rat))"
instance ..
end

instantiation bool :: to_real
begin
definition "to_real b = (if b then 1 else 0)"
instance ..
end

(* estimates mean and variance by sampling n time and computing the empiric mean/variance *)
definition estimate :: "nat \<Rightarrow> 'a :: to_real pmf \<Rightarrow> (real \<times> real) pmf"
  where "estimate n d = (
    map_pmf
      (\<lambda>xs. let m = sum_list (map to_real xs) / real n;
                s = sum_list (map (\<lambda>n. (to_real n - m)^2) xs) / real (n - 1)
            in (m, s))
      (replicate_pmf n d)
    )"

ML \<open>
signature PMF_ESTIMATE = sig
val estimate_cmd : xstring -> int -> string -> Toplevel.state -> unit
end

structure PMF_Estimate : PMF_ESTIMATE = struct

fun rat_of_term @{term "0 :: real"} = (0, 1)
  | rat_of_term @{term "1 :: real"} = (1, 1)
  | rat_of_term (@{term "uminus :: real \<Rightarrow> real"} $ t) = apfst (fn x => ~x) (rat_of_term t)
  | rat_of_term t =
      case t of
        Const (\<^const_name>\<open>numeral\<close>, _) $ _ => (snd (HOLogic.dest_number t), 1)
      | @{term "(/) :: real \<Rightarrow> real \<Rightarrow> real"} $ a $ b =>
          let
            val (a', b') = apply2 (snd o HOLogic.dest_number) (a, b)
          in
            if b' = 0 then raise TERM ("rat_of_term", [t])
            else if b' < 0 then (~a', ~b')
            else (a', b')
          end
      | _ => raise TERM ("rat_of_term", [t])

fun pretty_rat accuracy (a, b) =
  Real.fmt (StringCvt.FIX (SOME accuracy)) (Real.fromInt a / Real.fromInt b)

fun mk_pmfT T = Type (\<^type_name>\<open>pmf\<close>, [T])
fun mk_estimateC T = Const (\<^const_name>\<open>estimate\<close>, \<^typ>\<open>nat\<close> --> mk_pmfT T --> \<^typ>\<open>(real \<times> real) pmf\<close>)

fun dest_sample (Const (\<^const_name>\<open>SAMPLE\<close>, _) $ t) = t
  | dest_sample t = raise TERM ("dest_sample", [t])

fun estimate_cmd name n_samples raw_t state =
  let
    val accuracy = 4
    val ctxt = Toplevel.context_of state;
    val t = Syntax.read_term ctxt raw_t;
    val T = fastype_of t
    val T =
      case T of
        Type (\<^type_name>\<open>pmf\<close>, [T]) => T
      | _ => raise TYPE ("estimate_cmd", [T], [])
    val _ = writeln ("Using " ^ Int.toString n_samples ^ " samples...")
    val (m, v) =
      mk_estimateC T $ HOLogic.mk_number @{typ nat} n_samples $ t
      |> Value_Command.value_select name ctxt
      |> dest_sample
      |> HOLogic.dest_prod
      |> apply2 rat_of_term
      |> apply2 (pretty_rat accuracy)
  in
    Pretty.string_of (Pretty.block [Pretty.str "Estimated mean: ", Pretty.str m]) ^ "\n" ^
    Pretty.string_of (Pretty.block [Pretty.str "Estimated variance: ", Pretty.str v])
    |> writeln
  end
    handle TYPE (_, [T], _) =>
      Output.error_message (Pretty.string_of (Pretty.block
        [Pretty.str "Expression must be of type ?'a pmf, but has type ",
          Syntax.pretty_typ (Toplevel.context_of state) T, Pretty.str "."]))
end

val opt_evaluator =
  Scan.optional (\<^keyword>\<open>[\<close> |-- Parse.name --| \<^keyword>\<open>]\<close>) "";

val ten =
  Scan.one (fn t => Token.kind_of t = Token.Nat andalso Token.content_of t = "10")

(* parser for natural numbers, either literal or of form 10^k *)
val mynat =
  (ten |-- Args.$$$ "^" |-- Parse.nat) >> (fn k => Integer.pow k 10) || Parse.nat

val opt_samples =
  Scan.optional (\<^keyword>\<open>(\<close> |-- Args.$$$ "samples" |-- Args.colon |-- mynat --| \<^keyword>\<open>)\<close>) 1000;

val _ =
  Outer_Syntax.command \<^command_keyword>\<open>estimate_pmf\<close> "estimate mean and variance of a PMF by sampling"
    (opt_evaluator -- opt_samples -- Parse.term
      >> (fn ((name, n_samples), t) => Toplevel.keep (PMF_Estimate.estimate_cmd name n_samples t)));
\<close>

subsection \<open>Tests\<close>

subsubsection \<open>Bernoulli distribution\<close>

value "replicate_pmf 20 (bernoulli_pmf (1 / 7))"

(* theoretically: mean 0.14286, variance 0.12245 *)
estimate_pmf (samples: 10^5) "bernoulli_pmf (1 / 7)"

subsubsection \<open>Binomial distribution\<close>

value "binomial_pmf 100 (1 / 3)"

(* theoretically: mean 33.333, variance 22.222 *)
estimate_pmf (samples: 10^4) "binomial_pmf 100 (1/3)"

subsubsection \<open>Geometric distribution\<close>

value "replicate_pmf 100 (geometric_pmf (1/10))"

(* theoretically: mean 6, variance 42 *)
estimate_pmf (samples: 10^5) "geometric_pmf (1 / 7)"

subsubsection \<open>Sum of two dice rolls\<close>

definition bar :: "nat pmf"
  where "bar = do {x \<leftarrow> pmf_of_set {1..6}; y \<leftarrow> pmf_of_set {1..6}; return_pmf (x + y)}"

value "replicate_pmf 20 bar"

(* theoretically: mean 7, variance 5.8333 *)
estimate_pmf (samples: 10^5) "bar"

subsubsection \<open>Random permutations\<close>

lemma fold_random_permutation_code [code]:
  "fold_random_permutation f s (set xs) =
     (if xs = [] then return_pmf s
      else
        pmf_of_set (set xs) \<bind> (\<lambda>a. fold_random_permutation f (f a s) (set xs - {a})))"
  by (cases "xs = []") (auto)

value "fold_random_permutation (#) [] {1..200::int}"

subsubsection \<open>Additional examples from AFP\<close>

(* Fisher_Yates.Fisher_Yates *)

value "fisher_yates [1..<50]"

lemmas [code] = snd_sort_and_count_inversions[symmetric]

(* number of inversions of a random permutation. Theoretical mean: 612.5 *)
estimate_pmf (samples: 10^4) "map_pmf inversion_number (fisher_yates [1..50])"

(* Quick_Sort_Cost.Randomised_Quick_Sort *)

definition QS :: "nat \<Rightarrow> (nat list \<times> nat) pmf" where
  "QS n = (let R = Set.filter (\<lambda>(x,y). x \<le> y) ({1..n}\<times>{1..n}) in rquicksort R [1..<n+1])"

value "QS 10"

(* estimating mean/variance of quick sort cost *)
(* theoretical mean: 2(n + 1)H_n - 4n, i.e. for n = 10: 24.4373 *)
estimate_pmf (samples: 10^4) "map_pmf snd (QS 10)"
estimate_pmf (samples: 10^4) "rqs_cost 10"

(* Random_BSTs.Random_BSTs *)

lemma random_bst_code [code]:
 "random_bst (set xs) =
     (if xs = [] then
        return_pmf Leaf
      else do {
        x \<leftarrow> pmf_of_set (set xs);
        l \<leftarrow> random_bst (Set.filter (\<lambda>y. y < x) (set xs));
        r \<leftarrow> random_bst (Set.filter (\<lambda>y. y > x) (set xs));
        return_pmf (Node l x r)
     })"
  by (subst random_bst.simps) (auto simp: Set.filter_def)

value "random_bst {1..100::nat}"

(* height of random BST *)
(* theoretical mean: \<le> 16.433 *)
estimate_pmf "map_pmf height (random_bst {1..100::nat})"

(* internal path length of a random BST (is equidistributed to cost of randomised QuickSort *)
(* theoretical mean: 2(n + 1)H_n - 4n, i.e. for n = 100: 647.850 *)
estimate_pmf "map_pmf ipl (random_bst {1..100::nat})"
estimate_pmf "rqs_cost 100"

end


(*
    This file is a part of IsarMathLib -
    a library of formalized mathematics for Isabelle/Isar.

    Copyright (C) 2022  Daniel de la Concepcion

    This program is free software; Redistribution and use in source and binary forms,
    with or without modification, are permitted provided that the following conditions are met:

   1. Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.
   2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation and/or
   other materials provided with the distribution.
   3. The name of the author may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

*)

section \<open>Rings - Ideals of quotient rings\<close>

theory Ring_ZF_3 imports Ring_ZF_2 Group_ZF_5

begin

text \<open>This section studies the ideals of quotient rings,
and defines ring homomorphisms.\<close>

definition
  ringHomomor ("_{is a ring homomorphism}{_,_,_}\<rightarrow>{_,_,_}" 85)
  where "IsAring(R,A,M) \<Longrightarrow> IsAring(S,U,V) \<Longrightarrow> ringHomomor(f,R,A,M,S,U,V) \<equiv>
    Homomor(f,R,A,S,U)
    \<and> (\<forall>x\<in>R. \<forall>y\<in>R. f`(M`\<langle>x,y\<rangle>) = V`\<langle>f`x,f`y\<rangle>)
    \<and> f`(TheNeutralElement(R,M)) = TheNeutralElement(S,V)"

locale ring_homo =
  fixes R A M S U V f
  assumes origin:"IsAring(R,A,M)"
    and target:"IsAring(S,U,V)"
    and fun:"f:R\<rightarrow>S"
    and homomorphism:"f{is a ring homomorphism}{R,A,M}\<rightarrow>{S,U,V}"

  fixes ringa (infixl "\<ra>\<^sub>R" 90)
  defines ringa_def [simp]: "x\<ra>\<^sub>Rb \<equiv> A`\<langle>x,b\<rangle>"

  fixes ringminus ("\<rm>\<^sub>R _" 89)
  defines ringminus_def [simp]: "(\<rm>\<^sub>Rx) \<equiv> GroupInv(R,A)`(x)"

  fixes ringsub (infixl "\<rs>\<^sub>R" 90)
  defines ringsub_def [simp]: "x\<rs>\<^sub>Rb \<equiv> x\<ra>\<^sub>R(\<rm>\<^sub>Rb)"

  fixes ringm (infixl "\<cdot>\<^sub>R" 95)
  defines ringm_def [simp]: "x\<cdot>\<^sub>Rb \<equiv> M`\<langle>x,b\<rangle>"

  fixes ringzero ("\<zero>\<^sub>R")
  defines ringzero_def [simp]: "\<zero>\<^sub>R \<equiv> TheNeutralElement(R,A)"

  fixes ringone ("\<one>\<^sub>R")
  defines ringone_def [simp]: "\<one>\<^sub>R \<equiv> TheNeutralElement(R,M)"

  fixes ringtwo ("\<two>\<^sub>R")
  defines ringtwo_def [simp]: "\<two>\<^sub>R \<equiv> \<one>\<^sub>R\<ra>\<^sub>R\<one>\<^sub>R"

  fixes ringsq ("_\<^sup>2\<^sup>R" [96] 97)
  defines ringsq_def [simp]: "x\<^sup>2\<^sup>R \<equiv> x\<cdot>\<^sub>Rx"

  fixes ringas (infixl "\<ra>\<^sub>S" 90)
  defines ringas_def [simp]: "x\<ra>\<^sub>Sb \<equiv> U`\<langle>x,b\<rangle>"

  fixes ringminuss ("\<rm>\<^sub>S _" 89)
  defines ringminuss_def [simp]: "(\<rm>\<^sub>Sx) \<equiv> GroupInv(S,U)`(x)"

  fixes ringsubs (infixl "\<rs>\<^sub>S" 90)
  defines ringsubs_def [simp]: "x\<rs>\<^sub>Sb \<equiv> x\<ra>\<^sub>S(\<rm>\<^sub>Sb)"

  fixes ringms (infixl "\<cdot>\<^sub>S" 95)
  defines ringms_def [simp]: "x\<cdot>\<^sub>Sb \<equiv> V`\<langle> x,b\<rangle>"

  fixes ringzeros ("\<zero>\<^sub>S")
  defines ringzeros_def [simp]: "\<zero>\<^sub>S \<equiv> TheNeutralElement(S,U)"

  fixes ringones ("\<one>\<^sub>S")
  defines ringones_def [simp]: "\<one>\<^sub>S \<equiv> TheNeutralElement(S,V)"

  fixes ringtwos ("\<two>\<^sub>S")
  defines ringtwos_def [simp]: "\<two>\<^sub>S \<equiv> \<one>\<^sub>S\<ra>\<^sub>S\<one>\<^sub>S"

  fixes ringsqs ("_\<^sup>2\<^sup>S" [96] 97)
  defines ringsqs_def [simp]: "x\<^sup>2\<^sup>S \<equiv> x\<cdot>\<^sub>Sx"

abbreviation (in ring_homo) ideal_origin ("_\<triangleleft>R\<^sub>o")
  where "I\<triangleleft>R\<^sub>o \<equiv> ring0.Ideal(R,A,M,I)"

abbreviation (in ring_homo) prime_ideal_target ("_\<triangleleft>\<^sub>pR\<^sub>t")
  where "I\<triangleleft>\<^sub>pR\<^sub>t \<equiv> ring0.primeIdeal(S,U,V,I)"

abbreviation (in ring_homo) prime_ideal_origin ("_\<triangleleft>\<^sub>pR\<^sub>o")
  where "I\<triangleleft>\<^sub>pR\<^sub>o \<equiv> ring0.primeIdeal(R,A,M,I)"

abbreviation (in ring_homo) ideal_target ("_\<triangleleft>R\<^sub>t")
  where "I\<triangleleft>R\<^sub>t \<equiv> ring0.Ideal(S,U,V,I)"

abbreviation (in ring_homo) kernel ("ker" 90) where
  "ker \<equiv> f-``{\<zero>\<^sub>S}"

sublocale ring_homo < origin_ring:ring0
  using origin unfolding ring0_def by auto

sublocale ring_homo < target_ring:ring0 S U V ringas
  ringminuss ringsubs ringms ringzeros ringones ringtwos
  ringsqs
  using target unfolding ring0_def by auto

lemma (in ring_homo) homomor_dest_mult:
  assumes "x\<in>R" "y\<in>R"
  shows "f`(x\<cdot>\<^sub>Ry) = (f`x)\<cdot>\<^sub>S(f`y)"
  using assms origin target homomorphism ringHomomor_def by auto

lemma (in ring_homo) homomor_dest_add:
  assumes "x\<in>R" "y\<in>R"
  shows "f`(x\<ra>\<^sub>Ry) = (f`x)\<ra>\<^sub>S(f`y)"
  using homomor_eq[of R A S U f x y]
  origin target homomorphism assms
  unfolding IsAring_def ringHomomor_def[OF origin target]
  by auto

lemma (in ring_homo) homomor_dest_minus:
  assumes "x\<in>R"
  shows "f`(\<rm>\<^sub>Rx) = \<rm>\<^sub>S(f`x)"
  using image_inv[of R A S U f x]
  origin target homomorphism assms fun
  unfolding IsAring_def ringHomomor_def[OF origin target]
  by auto

lemma (in ring_homo) homomor_dest_subs:
  assumes "x\<in>R" "y\<in>R"
  shows "f`(x\<rs>\<^sub>Ry) = (f`x)\<rs>\<^sub>S(f`y)"
  using assms homomor_dest_add[of x "\<rm>\<^sub>Ry"]
    homomor_dest_minus[of y]
  using origin_ring.Ring_ZF_1_L3(1) by auto

lemma (in ring_homo) homomor_dest_zero:
  shows "f`(\<zero>\<^sub>R) = \<zero>\<^sub>S"
proof-
  have "f`(\<zero>\<^sub>R) = f`(\<zero>\<^sub>R\<rs>\<^sub>R\<zero>\<^sub>R)"
    using origin_ring.Ring_ZF_1_L3(7) origin_ring.Ring_ZF_1_L2(1)
    by auto
  then have "f`(\<zero>\<^sub>R) = f`(\<zero>\<^sub>R)\<rs>\<^sub>S(f`\<zero>\<^sub>R)"
    using homomor_dest_subs origin_ring.Ring_ZF_1_L2(1)
    by auto
  then show ?thesis using target_ring.Ring_ZF_1_L3(7)
    origin_ring.Ring_ZF_1_L2(1) apply_type[OF fun] by auto
qed

lemma (in ring_homo) preimage_ideal:
  assumes "J\<triangleleft>R\<^sub>t"
  shows "(f-``J)\<triangleleft>R\<^sub>o" "ker \<subseteq> f-``J"
proof-
  have "IsAnormalSubgroup(R,A,f-``J)"
    using preimage_normal_subgroup[OF _ _ _ fun]
      target_ring.ideal_normal_add_subgroup origin assms
      target homomorphism
    unfolding IsAring_def ring0_def
    ringHomomor_def[OF origin target] by auto
  then have "IsAsubgroup(f-``J,A)" unfolding IsAnormalSubgroup_def
    by auto moreover
  {
    fix x y assume xy:"x\<in>f-``J" "y\<in>R"
    from xy(1) have "f`x \<in> J" "x\<in>R" using func1_1_L15 fun
      by auto
    moreover have "f`y\<in>S" using xy(2) apply_type fun
      by auto
    ultimately have "V`\<langle>f`x,f`y\<rangle>\<in>J" "V`\<langle>f`y,f`x\<rangle>\<in>J"
      using target_ring.ideal_dest_mult assms
      by auto
    then have "f`(M`\<langle>x,y\<rangle>)\<in>J" "f`(M`\<langle>y,x\<rangle>)\<in>J"
      using homomor_dest_mult xy(2) \<open>x\<in>R\<close>
      by auto
    moreover have "M`\<langle>x,y\<rangle>\<in>R" "M`\<langle>y,x\<rangle>\<in>R" using xy(2) \<open>x\<in>R\<close>
      origin_ring.Ring_ZF_1_L4(3) by auto
    ultimately have "M`\<langle>x,y\<rangle>\<in>f-``J" "M`\<langle>y,x\<rangle>\<in>f-``J"
      using func1_1_L15 fun by auto
  }
  ultimately show "(f-``J)\<triangleleft>R\<^sub>o" using origin_ring.Ideal_def by auto
  have "\<zero>\<^sub>S\<in>J" using assms target_ring.ideal_dest_zero by auto
  then show "ker \<subseteq> f-``J" by auto
qed

text\<open>Even more, if the target ring of the homomorphism is commutative
or the homomorphism is surjective; we show that if the ideal es prime,
then its preimage is also. Note that this is not true in general.\<close>

lemma (in ring_homo) preimage_prime_ideal_comm:
  assumes "J\<triangleleft>\<^sub>pR\<^sub>t" "V{is commutative on}S"
  shows "(f-``J)\<triangleleft>\<^sub>pR\<^sub>o"
proof(rule origin_ring.equivalent_prime_ideal_2)
  show "(f-``J)\<triangleleft>R\<^sub>o" using preimage_ideal assms unfolding target_ring.primeIdeal_def by auto
  {
    assume "R = f-`` J"
    then have "R = {x\<in>R. f`x \<in>J}"
      using fun func1_1_L15 by auto
    moreover have "\<one>\<^sub>R\<in>R" using origin_ring.Ring_ZF_1_L2(2).
    ultimately have "\<one>\<^sub>R\<in>{x\<in>R. f`x \<in>J}" by auto
    then have "f`(\<one>\<^sub>R) \<in>J" by auto
    moreover have "f`\<one>\<^sub>R = \<one>\<^sub>S" using homomorphism
      unfolding ringHomomor_def[OF origin_ring.ringAssum
          target_ring.ringAssum] by auto
    ultimately have "\<one>\<^sub>S \<in> J" by auto
    then have False using target_ring.ideal_with_one
      assms unfolding target_ring.primeIdeal_def by auto
  }
  then show "f -`` J \<noteq> R" by auto
  show "\<forall>x\<in>R. \<forall>y\<in>R. (\<forall>z\<in>R. x \<cdot>\<^sub>R z \<cdot>\<^sub>R y \<in> f -`` J) \<longrightarrow>
                 x \<in> f -`` J \<or> y \<in> f -`` J"
  proof(safe)
    fix x y assume as:"x\<in>R" "y\<in>R" "\<forall>z\<in>R. x \<cdot>\<^sub>R z \<cdot>\<^sub>R y \<in> f -`` J" "y \<notin> f -`` J"
    {
      fix s assume s:"s\<in>S"
      then have "(f`x)\<cdot>\<^sub>Ss\<cdot>\<^sub>S(f`y) = s\<cdot>\<^sub>S((f`x)\<cdot>\<^sub>S(f`y))"
        using assms(2) unfolding IsCommutative_def
        using apply_type[OF fun as(1)]
          target_ring.Ring_ZF_1_L11(2) apply_type[OF fun as(2)]
        by auto
      then have "(f`x)\<cdot>\<^sub>Ss\<cdot>\<^sub>S(f`y) = s\<cdot>\<^sub>S(f`(x\<cdot>\<^sub>Ry))"
        using homomor_dest_mult[OF as(1,2)]
        by auto moreover
      from as(3) have "x\<cdot>\<^sub>Ry : f-``J" using origin_ring.Ring_ZF_1_L2(2)
        origin_ring.Ring_ZF_1_L3(5)[OF as(1)] by force
      then have "f`(x\<cdot>\<^sub>Ry) : J" using func1_1_L15 fun by auto
      with s have "s\<cdot>\<^sub>S(f`(x\<cdot>\<^sub>Ry)) :J" using assms(1)
        unfolding target_ring.primeIdeal_def using target_ring.ideal_dest_mult(2)
        by auto
      ultimately have "(f`x)\<cdot>\<^sub>Ss\<cdot>\<^sub>S(f`y):J" by auto
    }
    then have "\<forall>z\<in>S. (f`x) \<cdot>\<^sub>S z \<cdot>\<^sub>S (f`y) \<in> J" by auto
    with target_ring.equivalent_prime_ideal[OF assms(1)]
    apply_type[OF fun] as(1,2) have "f`x:J\<or>f`y:J" by auto
    with as(4,2) have "f`x:J" using func1_1_L15 fun by auto
    then show "x:f-``J" using as(1) func1_1_L15 fun by auto
  qed
qed

lemma (in ring_homo) preimage_prime_ideal_surj:
  assumes "J\<triangleleft>\<^sub>pR\<^sub>t" "f:surj(R,S)"
  shows "(f-``J)\<triangleleft>\<^sub>pR\<^sub>o"
proof(rule origin_ring.equivalent_prime_ideal_2)
  show "(f-``J)\<triangleleft>R\<^sub>o" using preimage_ideal assms unfolding target_ring.primeIdeal_def by auto
  {
    assume "R = f-`` J"
    then have "R = {x\<in>R. f`x \<in>J}"
      using fun func1_1_L15 by auto
    moreover have "\<one>\<^sub>R\<in>R" using origin_ring.Ring_ZF_1_L2(2).
    ultimately have "\<one>\<^sub>R\<in>{x\<in>R. f`x \<in>J}" by auto
    then have "f`(\<one>\<^sub>R) \<in>J" by auto
    moreover have "f`\<one>\<^sub>R = \<one>\<^sub>S" using homomorphism
      unfolding ringHomomor_def[OF origin_ring.ringAssum
          target_ring.ringAssum] by auto
    ultimately have "\<one>\<^sub>S \<in> J" by auto
    then have False using target_ring.ideal_with_one
      assms unfolding target_ring.primeIdeal_def by auto
  }
  then show "f -`` J \<noteq> R" by auto
  show "\<forall>x\<in>R. \<forall>y\<in>R. (\<forall>z\<in>R. x \<cdot>\<^sub>R z \<cdot>\<^sub>R y \<in> f -`` J) \<longrightarrow>
                 x \<in> f -`` J \<or> y \<in> f -`` J"
  proof(safe)
    fix x y assume as:"x\<in>R" "y\<in>R" "\<forall>z\<in>R. x \<cdot>\<^sub>R z \<cdot>\<^sub>R y \<in> f -`` J" "y \<notin> f -`` J"
    {
      fix s assume s:"s\<in>S"
      with assms(2) obtain t where t:"s=f`t" "t:R"
        unfolding surj_def by auto
      then have "(f`x)\<cdot>\<^sub>S(f`t)\<cdot>\<^sub>S(f`y) = f`(x\<cdot>\<^sub>Rt\<cdot>\<^sub>Ry)"
        using homomor_dest_mult as(1,2) t(2)
        origin_ring.Ring_ZF_1_L4(3) by auto
      moreover have "(x\<cdot>\<^sub>Rt\<cdot>\<^sub>Ry)\<in>f-``J" using as(3) t(2) by auto
      ultimately have "(f`x)\<cdot>\<^sub>S(f`t)\<cdot>\<^sub>S(f`y)\<in>J"
        using func1_1_L15 fun by auto
      with t(1) have "(f`x)\<cdot>\<^sub>Ss\<cdot>\<^sub>S(f`y)\<in>J" by auto
    }
    then have "\<forall>z\<in>S. (f`x) \<cdot>\<^sub>S z \<cdot>\<^sub>S (f`y) \<in> J" by auto
    with target_ring.equivalent_prime_ideal[OF assms(1)]
    apply_type[OF fun] as(1,2) have "f`x:J\<or>f`y:J" by auto
    with as(4,2) have "f`x:J" using func1_1_L15 fun by auto
    then show "x:f-``J" using as(1) func1_1_L15 fun by auto
  qed
qed

section\<open>Quotient ring with quotient map\<close>

locale ring2 = ring0 +
  fixes I
  assumes idealAssum:"I\<triangleleft>R"

  fixes quot ("R\<^sub>I")
  defines quot_def [simp]: "R\<^sub>I \<equiv> QuotientBy(I)"

  fixes qrel ("r\<^sub>I")
  defines qrel_def [simp]: "r\<^sub>I \<equiv> QuotientGroupRel(R,A,I)"

  fixes qfun ("f\<^sub>I")
  defines qfun_def [simp]: "f\<^sub>I \<equiv> \<lambda>r\<in>R. r\<^sub>I ``{r}"

  fixes qadd ("A\<^sub>I")
  defines qadd_def [simp]: "A\<^sub>I \<equiv> QuotientGroupOp(R, A, I)"

  fixes qmul ("M\<^sub>I")
  defines qmul_def [simp]: "M\<^sub>I \<equiv> ProjFun2(R, qrel, M)"

abbreviation (in ring2) qideal ("_\<triangleleft>R\<^sub>I") where
  "J\<triangleleft>R\<^sub>I \<equiv> ring0.Ideal(R\<^sub>I,A\<^sub>I,M\<^sub>I,J)"

abbreviation (in ring2) qprimeIdeal ("_\<triangleleft>\<^sub>pR\<^sub>I") where
  "J\<triangleleft>\<^sub>pR\<^sub>I \<equiv> ring0.primeIdeal(R\<^sub>I,A\<^sub>I,M\<^sub>I,J)"

lemma (in ring_homo) image_kernel:
  assumes "x\<in>ker"
  shows "f`x = \<zero>\<^sub>S"
  using assms func1_1_L15 fun by auto

corollary (in ring_homo) image_kernel_2:
  shows "f``(ker) = {\<zero>\<^sub>S}"
proof-
  have "\<zero>\<^sub>R \<in>ker" using homomor_dest_zero origin_ring.Ring_ZF_1_L2(1)
    func1_1_L15 fun by auto moreover
  have "ker \<subseteq> R" using func1_1_L15[OF fun, of "{\<zero>\<^sub>S}"] by auto
  then have "f `` (ker) = {f ` x . x \<in> ker}"
    using func_imagedef[OF fun, of ker] by auto
  ultimately show ?thesis using image_kernel by auto
qed

sublocale ring2 < quotient_ring: ring0 quot qadd qmul
  "\<lambda>x y. ideal_radd(x,I,y)" "\<lambda>y. ideal_rmin(I,y)"
  "\<lambda>x y. ideal_rsub(x,I,y)" "\<lambda>x y. ideal_rmult(x,I,y)"
  "\<zero>\<^sub>I" "\<one>\<^sub>I" "\<two>\<^sub>I" "\<lambda>x. (x\<^sup>2\<^sup>I)" unfolding ring0_def quot_def
  using quotientBy_is_ring[OF idealAssum] apply simp
  unfolding ideal_radd_def ideal_rmin_def
            ideal_rsub_def ideal_rmult_def
         ideal_rzero_def ideal_rone_def
         ideal_rtwo_def ideal_rsqr_def apply auto
  using neutral_quotient[OF idealAssum] apply simp
  using one_quotient[OF idealAssum] apply simp
  using two_quotient[OF idealAssum] by simp

text\<open>The quotient map is a homomorphism of rings\<close>

theorem (in ring2) quotient_fun_homomor:
  shows "f\<^sub>I{is a ring homomorphism}{R,A,M}\<rightarrow>{R\<^sub>I,A\<^sub>I,M\<^sub>I}"
  unfolding ringHomomor_def[OF ringAssum quotient_ring.ringAssum]
proof(safe)
  from add_group.quotient_map[OF ideal_normal_add_subgroup[OF idealAssum]]
    show "f\<^sub>I{is a homomorphism}{R,A}\<rightarrow>{R\<^sub>I,A\<^sub>I}"
    unfolding qfun_def quot_def qadd_def QuotientBy_def[OF idealAssum] by auto
  {
    fix x y assume as:"x\<in>R" "y\<in>R"
    have "f\<^sub>I ` (x\<cdot>y) = QuotientGroupRel(R,A,I)``{x\<cdot>y}"
      unfolding qfun_def using as Ring_ZF_1_L4(3)
      lamE lam_funtype by auto
    then have "f\<^sub>I ` (x\<cdot>y) = ((QuotientGroupRel(R,A,I)``{x}){\<cdot>I}(QuotientGroupRel(R,A,I)``{y}))"
      using EquivClass_1_L10[OF equiv_rel[OF idealAssum]
          quotientBy_mul_monoid(1)[OF idealAssum]] as by auto
    then have "f\<^sub>I ` (x\<cdot>y) = ((f\<^sub>I `x){\<cdot>I}(f\<^sub>I `y))" unfolding qfun_def
      using as lamE lam_funtype by auto
    then show "f\<^sub>I ` (M ` \<langle>x, y\<rangle>) =M\<^sub>I `  \<langle>f\<^sub>I ` x, f\<^sub>I ` y\<rangle>" by auto
  }
  have "f\<^sub>I `\<one> = QuotientGroupRel(R,A,I)``{\<one>}"
    unfolding qfun_def using lam_funtype lamE Ring_ZF_1_L2(2)
    by auto
  then have "f\<^sub>I `\<one> = TheNeutralElement(QuotientBy(I),ProjFun2(R, QuotientGroupRel(R,A,I), M))"
    using Group_ZF_2_2_L1[OF _ equiv_rel[OF idealAssum]
          quotientBy_mul_monoid(1)[OF idealAssum]]
          ringAssum unfolding IsAring_def QuotientBy_def[OF idealAssum]
    by auto
  then show "f\<^sub>I ` TheNeutralElement(R, M) = TheNeutralElement(R\<^sub>I, M\<^sub>I)"
    unfolding quot_def by auto
qed

text\<open>The quotient map is surjective\<close>

lemma (in ring2) quot_fun:
  shows "f\<^sub>I\<in>surj(R,R\<^sub>I)" unfolding qfun_def using lam_funtype unfolding quot_def QuotientBy_def[OF idealAssum]
    quotient_def qrel_def surj_def by auto

sublocale ring2 < quot_homomorphism: ring_homo R A M quot qadd qmul qfun
  _ _ _ _ _ _ _ _ "\<lambda>x y. ideal_radd(x,I,y)" "\<lambda>y. ideal_rmin(I,y)"
  "\<lambda>x y. ideal_rsub(x,I,y)" "\<lambda>x y. ideal_rmult(x,I,y)"
  "\<zero>\<^sub>I" "\<one>\<^sub>I" "\<two>\<^sub>I" "\<lambda>x. (x\<^sup>2\<^sup>I)"
  unfolding ring_homo_def using ringAssum quotient_ring.ringAssum
    quotient_fun_homomor quot_fun unfolding surj_def by auto

lemma (in ring2) quotient_kernel:
  shows "quot_homomorphism.kernel = I"
proof
  {
    fix t assume t:"t\<in>quot_homomorphism.kernel"
    then have t:"f\<^sub>I`t = \<zero>\<^sub>I" "t\<in>R" using quot_homomorphism.image_kernel
      func1_1_L15[OF surj_is_fun[OF quot_fun]] by auto
    then have "r\<^sub>I``{t} = \<zero>\<^sub>I" using beta by auto
    then have "t\<in>I" using add_group.Group_ZF_2_4_L5E[OF
      ideal_normal_add_subgroup[OF idealAssum] t(2)]
      neutral_quotient[OF idealAssum] unfolding
      ideal_rzero_def QuotientBy_def[OF idealAssum]
      by auto
  }
  then show "quot_homomorphism.kernel \<subseteq> I" by auto
  {
    fix t assume t:"t\<in>I"
    then have tt:"t\<in>R" using ideal_dest_subset idealAssum by auto
    then have "r\<^sub>I``{t} = \<zero>\<^sub>I" using add_group.Group_ZF_2_4_L5E[OF
      ideal_normal_add_subgroup[OF idealAssum] tt] t
      neutral_quotient[OF idealAssum] unfolding
      ideal_rzero_def QuotientBy_def[OF idealAssum]
      by auto
    then have "f\<^sub>I`t = \<zero>\<^sub>I" using beta tt by auto
    with tt have "t\<in>f\<^sub>I-``{\<zero>\<^sub>I}" using func1_1_L15
      surj_is_fun quot_fun by auto
  }
  then show "I \<subseteq> quot_homomorphism.kernel" by auto
qed

sublocale ring2 < quotient_ring: ring0 quot qadd qmul
  "\<lambda>x y. ideal_radd(x,I,y)" "\<lambda>y. ideal_rmin(I,y)"
  "\<lambda>x y. ideal_rsub(x,I,y)" "\<lambda>x y. ideal_rmult(x,I,y)"
  "\<zero>\<^sub>I" "\<one>\<^sub>I" "\<two>\<^sub>I" "\<lambda>x. (x\<^sup>2\<^sup>I)" unfolding ring0_def quot_def
  using quotientBy_is_ring[OF idealAssum] apply simp
  unfolding ideal_radd_def ideal_rmin_def
            ideal_rsub_def ideal_rmult_def
         ideal_rzero_def ideal_rone_def
         ideal_rtwo_def ideal_rsqr_def apply auto
  using neutral_quotient[OF idealAssum] apply simp
  using one_quotient[OF idealAssum] apply simp
  using two_quotient[OF idealAssum] by simp

sublocale ring2 < quot_homomorphism: ring_homo R A M quot qadd qmul qfun
  _ _ _ _ _ _ _ _ "\<lambda>x y. ideal_radd(x,I,y)" "\<lambda>y. ideal_rmin(I,y)"
  "\<lambda>x y. ideal_rsub(x,I,y)" "\<lambda>x y. ideal_rmult(x,I,y)"
  "\<zero>\<^sub>I" "\<one>\<^sub>I" "\<two>\<^sub>I" "\<lambda>x. (x\<^sup>2\<^sup>I)"
  unfolding ring_homo_def using ringAssum quotient_ring.ringAssum
    quotient_fun_homomor quot_fun unfolding surj_def by auto

theorem (in ring_homo) kernel_empty_image:
  assumes "J\<triangleleft>R" "I \<subseteq> ker" "I\<triangleleft>R"
  shows "f``(J+\<^sub>II) = f``J" "f``(I+\<^sub>IJ) = f``J"
proof-
  have sub:"J+\<^sub>II \<subseteq> R" using assms
    origin_ring.sum_ideals_is_ideal[THEN origin_ring.ideal_dest_subset]
    origin_ring.ideal_dest_subset by auto
  {
    fix t assume "t\<in>f``(J+\<^sub>II)"
    then obtain q where q:"q\<in>J+\<^sub>II" "t=f`q"
      using func_imagedef fun sub(1) by auto
    from q(1) have "q\<in>A``(J\<times>I)" "J\<times>I \<subseteq> R\<times>R"
      using origin_ring.sum_ideals_is_sum_elements
      assms(1,3) origin_ring.ideal_dest_subset by auto
    then obtain qj qi where qji:"qj\<in>J" "qi\<in>I"
      "q=qj\<ra>\<^sub>Rqi" using func_imagedef[of A "R\<times>R" R]
      origin_ring.add_group.groupAssum unfolding IsAgroup_def
      IsAmonoid_def IsAssociative_def by auto
    from qji(3) have "f`q = f`(qj\<ra>\<^sub>Rqi)" by auto
    with qji(1,2) assms(1,3) have "(f`q) = ((f`qj)\<ra>\<^sub>S(f`qi))"
      using homomor_dest_add[of qj qi] origin_ring.ideal_dest_subset
      by auto
    moreover from qji(2) assms(2) have "qi\<in>ker" by auto
    ultimately have "f ` q = ((f ` qj)\<ra>\<^sub>S\<zero>\<^sub>S)" using image_kernel
      by auto
    then have "f ` qj \<in>S \<Longrightarrow> f ` q = (f ` qj)"
      using target_ring.Ring_ZF_1_L3(3) by auto
    moreover have "qj\<in>R" using assms qji(1)
      origin_ring.ideal_dest_subset by auto
    then have "f ` qj \<in>S" using apply_type[OF fun]
      by auto
    ultimately have "f ` q = (f ` qj)" by auto
    with q(2) have "t = f` qj" by auto
    then have "t\<in> f``J" using qji(1) func_imagedef
      fun assms origin_ring.ideal_dest_subset by auto
  }
  then have "f `` (J +\<^sub>I I) \<subseteq> f `` J" by auto
  moreover
  {
    fix t assume t:"t\<in>f``J"
    then obtain q where q:"q\<in>J" "t=f`q"
      using func_imagedef fun
      assms(1) origin_ring.ideal_dest_subset by auto
    from q(1) have "q\<in>J\<union>I" by auto moreover
    have "J\<union>I \<subseteq> R" using assms(1,3) origin_ring.ideal_dest_subset by auto
    ultimately have "q\<in>\<langle>J\<union>I\<rangle>\<^sub>I" using origin_ring.generated_ideal_contains_set by auto
    then have "q\<in>J+\<^sub>II" unfolding origin_ring.sumIdeal_def[OF assms(1,3)].
    with q(2) have "t\<in>f``(J+\<^sub>II)" using func_imagedef
      fun sub by auto
  }
  then have "f``J \<subseteq> f `` (J +\<^sub>I I)" by auto
  ultimately show "f `` (J +\<^sub>I I) = f``J" "f `` (I +\<^sub>I J) = f``J"
    using origin_ring.sum_ideals_commute assms(1,3) by auto
qed

subsection\<open>Quotient ideals\<close>

text\<open>The preimage of an ideal is an ideal, so it applies to the
quotient map; but the preimage ideal contains the quotient ideal.\<close>

lemma (in ring2) ideal_quot_preimage:
  assumes "J\<triangleleft>R\<^sub>I"
  shows "(f\<^sub>I-``J) \<triangleleft>R" "I \<subseteq> f\<^sub>I-``J"
proof-
  from quot_homomorphism.preimage_ideal[OF assms]
  show "(f\<^sub>I-``J) \<triangleleft>R" by auto
  {
    fix x assume x:"x\<in>I"
    with quot_fun have "f\<^sub>I`x = r\<^sub>I``{x}"
      using lamI[of x R] ideal_dest_subset[OF idealAssum]
      apply_equality[of x "r\<^sub>I``{x}" "f\<^sub>I"] unfolding qfun_def
      by auto
    then have "f\<^sub>I`x = \<zero>\<^sub>I" using add_group.Group_ZF_2_4_L5E[OF
          ideal_normal_add_subgroup[OF idealAssum], of x
          "r\<^sub>I" "\<zero>\<^sub>I"] x ideal_dest_subset[OF idealAssum]
      unfolding qrel_def ideal_rzero_def using
        Group_ZF_2_4_L5B[OF _ ideal_normal_add_subgroup[OF idealAssum]]
      using ringAssum unfolding IsAring_def by auto
    then have "f\<^sub>I`x \<in> J" using quotient_ring.ideal_dest_zero
      assms by auto
    then have "x\<in>f\<^sub>I-``J" using x ideal_dest_subset[OF idealAssum]
      quot_fun func1_1_L15 by auto
  }
  then show "I \<subseteq> f\<^sub>I-``J" by auto
qed

text\<open>Since the map is surjective, the image is also an ideal\<close>

lemma (in ring_homo) image_ideal_surj:
  assumes "J\<triangleleft>R\<^sub>o" "f\<in>surj(R,S)"
  shows "(f``J) \<triangleleft>R\<^sub>t" unfolding target_ring.Ideal_def
proof
  show "IsAsubgroup(f``J,U)"
  proof (rule image_subgroup)
    show "IsAgroup(R,A)" using origin_ring.ringAssum unfolding IsAring_def by auto
    show "f : R \<rightarrow> S" using fun .
    show "IsAsubgroup(J,A)" using assms unfolding origin_ring.Ideal_def by auto
    show "f{is a homomorphism}{R,A}\<rightarrow>{S,U}" using homomorphism
      unfolding ringHomomor_def[OF origin target]
      by auto
    show "IsAgroup(S,U)" using target_ring.ringAssum
      unfolding IsAring_def by auto
  qed
  {
    fix x y assume xy:"x\<in>f``J" "y\<in>S"
    from xy(1) obtain j where x:"x=f`j" "j\<in>J" using func_imagedef
      fun origin_ring.ideal_dest_subset[OF assms(1)] by auto
    from xy(2) have "y\<in>f``R" using assms(2) surj_range_image_domain
      by auto
    then obtain s where y:"y=f`s" "s\<in>R" using func_imagedef
      origin_ring.ideal_dest_subset[OF assms(1)]
      fun by auto
    from x(1) y(1) have "V`\<langle>x,y\<rangle> = V`\<langle>f`j,f`s\<rangle>"
      "V`\<langle>y,x\<rangle> = V`\<langle>f`s,f`j\<rangle>" by auto
    then have "V`\<langle>x,y\<rangle> = f`(M`\<langle>j,s\<rangle>)" "V`\<langle>y,x\<rangle> = f`(M`\<langle>s,j\<rangle>)"
      using homomor_dest_mult[of s j]
        homomor_dest_mult[of j s]
        x(2) y(2) origin_ring.ideal_dest_subset[OF assms(1)] by auto
    moreover have "j\<cdot>\<^sub>Rs\<in>J" "s\<cdot>\<^sub>Rj\<in>J" using origin_ring.ideal_dest_mult[OF assms(1)]
      x(2) y(2) by auto
    ultimately have "(x\<cdot>\<^sub>Sy)\<in>f``J" "(y\<cdot>\<^sub>Sx)\<in>f``J"
      using func_imagedef fun origin_ring.ideal_dest_subset[OF assms(1)]
      by auto
  }
  then show "\<forall>x\<in>f `` J. \<forall>y\<in>S. (y\<cdot>\<^sub>Sx) \<in> f `` J \<and> (x\<cdot>\<^sub>Sy) \<in> f `` J"
    by auto
qed

corollary (in ring_homo) prime_ideal_quot:
  assumes "J\<triangleleft>R\<^sub>t" "K\<triangleleft>R\<^sub>t" "f:surj(R,S)"
  shows "f-``(target_ring.productIdeal(J, K)) = origin_ring.sumIdeal(origin_ring.productIdeal((f-``J),(f-``K)), ker)"
proof
  let ?P = "origin_ring.sumIdeal(origin_ring.productIdeal((f-``J),(f-``K)), f-``{\<zero>\<^sub>S})"
  have qRI:"target_ring.productIdeal(J, K)\<triangleleft>R\<^sub>t"
    using target_ring.product_in_intersection(2)
    assms by auto
  from assms(1,2) have ideals:"(f-``J) \<triangleleft>R\<^sub>o" "(f-``K) \<triangleleft>R\<^sub>o"
    using preimage_ideal by auto
  then have idealJK:"((f-``J) \<cdot>\<^sub>I (f-``K)) \<triangleleft>R\<^sub>o"
    using origin_ring.product_in_intersection(2) by auto
  have idealSum:"?P \<triangleleft>R"
    using origin_ring.sum_ideals_is_sum_elements[OF idealJK preimage_ideal(1)[OF target_ring.zero_ideal]]
      origin_ring.sum_elements_is_ideal[OF idealJK preimage_ideal(1)[OF target_ring.zero_ideal]]
    by auto
  then have ideal:"(f``?P) \<triangleleft>R\<^sub>t"
    using image_ideal_surj assms(3)
    by auto
  {
    fix t assume "t\<in>V ``(J\<times>K)" moreover
    have "J\<times>K \<subseteq> S\<times>S" using assms
      target_ring.ideal_dest_subset by auto moreover
    have "V:S\<times>S \<rightarrow> S" using target_ring.ringAssum
      unfolding IsAring_def IsAmonoid_def
      IsAssociative_def by auto
    ultimately obtain j k where jk:"j\<in>J" "k\<in>K" "t=V`\<langle>j,k\<rangle>"
      using func_imagedef by auto
    from jk(1) have "j\<in>S" using assms(1)
      target_ring.ideal_dest_subset by auto
    then obtain jj where jj:"jj\<in>R" "f`jj = j" using
      assms(3) unfolding surj_def by auto
    from jk(2) have "k\<in>S" using assms(2)
      target_ring.ideal_dest_subset by auto
    then obtain kk where kk:"kk\<in>R" "f`kk = k" using
      assms(3) unfolding surj_def by auto
    from jk(3) jj(2) kk(2)
    have "t=V`\<langle>f`jj,f`kk\<rangle>" by auto
    then have t:"t=f`(M`\<langle>jj,kk\<rangle>)" using
      homomor_dest_mult[OF jj(1) kk(1)] by auto
    have "f-``J \<subseteq> R" using assms(3)
      using func1_1_L6A[OF surj_is_fun] by auto moreover
    have "f-``K \<subseteq> R" using assms(3)
      using func1_1_L6A[OF surj_is_fun] by auto ultimately
    have sub:"(f-``J)\<times>(f-``K) \<subseteq> R\<times>R" by auto moreover
    have "M:R\<times>R \<rightarrow> R" using origin_ring.ringAssum
      unfolding IsAring_def IsAmonoid_def
      IsAssociative_def by auto moreover
    {
      from jj have "jj\<in>f-``J" using func1_1_L15
        assms(3) jk(1) unfolding surj_def by auto moreover
      from kk have "kk\<in>f-``K" using func1_1_L15
        assms(3) jk(2) unfolding surj_def by auto ultimately
      have "\<langle>jj,kk\<rangle>\<in>(f-``J)\<times>(f-``K)" by auto
    } ultimately
    have "M`\<langle>jj,kk\<rangle> \<in> M``((f-``J)\<times>(f-``K))"
      using func_imagedef by auto
    then have "M`\<langle>jj,kk\<rangle> \<in> (f-``J) \<cdot>\<^sub>I (f-``K)"
      using preimage_ideal
      assms origin_ring.product_in_intersection(3) by blast
    then have "M`\<langle>jj,kk\<rangle> \<in> ((f-``J) \<cdot>\<^sub>I (f-``K))\<union>(f-``{\<zero>\<^sub>S})"
      by auto moreover
    have "((f-``J) \<cdot>\<^sub>I (f -`` K))\<union>(f-``{\<zero>\<^sub>S})\<subseteq>R" using
      func1_1_L6A[OF surj_is_fun[OF assms(3)]]
      origin_ring.ideal_dest_subset[OF idealJK] by auto
    ultimately have "M`\<langle>jj,kk\<rangle> \<in> ?P"
      unfolding origin_ring.sumIdeal_def[OF idealJK
          preimage_ideal(1)[OF target_ring.zero_ideal]]
      using origin_ring.generated_ideal_contains_set[of
          "((f-`` J) \<cdot>\<^sub>I (f-`` K)) \<union> (f-``{\<zero>\<^sub>S})"] by blast
    then have "f`(M`\<langle>jj,kk\<rangle>) \<in> f``?P"
      using func1_1_L15D[OF surj_is_fun[OF assms(3)] _
       idealSum[THEN origin_ring.ideal_dest_subset]] by auto
    moreover note t ultimately
    have "t\<in>(f``?P)"
      by auto
  }
  then have "V `` (J \<times> K) \<subseteq> f``?P" by blast
  then have "target_ring.generatedIdeal(V `` (J \<times> K)) \<subseteq> f``?P"
    using ideal target_ring.generated_ideal_small by auto
  then have "target_ring.productIdeal(J, K) \<subseteq> f``(?P)"
    unfolding target_ring.productIdeal_def[OF assms(1,2)].
  then have R:"f-``target_ring.productIdeal(J, K) \<subseteq> f-``(f``?P)"
    unfolding vimage_def by blast
  have "((f-``J) \<cdot>\<^sub>I (f-``K)) \<union> (f -`` {\<zero>\<^sub>S}) \<subseteq> R" using idealJK
    origin_ring.ideal_dest_subset func1_1_L6A[OF surj_is_fun]
    assms(3) by blast
  then have p:"(f -`` {\<zero>\<^sub>S}) \<subseteq> ?P"
    unfolding origin_ring.sumIdeal_def[OF idealJK
        preimage_ideal(1)[OF target_ring.zero_ideal]]
    using origin_ring.generated_ideal_contains_set
      by blast
    moreover
  from idealSum origin_ring.ideal_dest_subset
    have "?P \<subseteq>R" by auto
  moreover note idealSum
  ultimately have P_ideal:"?P \<in> {N\<in>\<I>. f-``{\<zero>\<^sub>S} \<subseteq> N}"
    by auto
  have P:"f``?P \<subseteq> S"
    using ideal P_ideal
    assms(3) target_ring.ideal_dest_subset by auto
  {
    fix t assume "t\<in>f-``(f``?P)"
    then have t:"f`t\<in>f``?P" "t\<in>R" using func1_1_L15
      surj_is_fun[OF assms(3)] by auto
    then obtain s where s:"f`t = f`s" "s\<in>?P" using
      func_imagedef[OF surj_is_fun[OF assms(3)]] P_ideal by auto
    from s(2) have ss:"s\<in>R" using P_ideal by auto
    from s(1) have "(f`t) \<rs>\<^sub>S (f`s) = \<zero>\<^sub>S" using
      target_ring.Ring_ZF_1_L3(7)[OF apply_type[OF surj_is_fun[OF assms(3)]
      t(2)]] by auto
    then have "f`(t\<rs>\<^sub>Rs) = \<zero>\<^sub>S" using homomor_dest_subs
      t(2) ss by auto moreover
    from t(2) ss have "t\<rs>\<^sub>Rs \<in>R" using origin_ring.Ring_ZF_1_L4(2) by auto
    ultimately have "t\<rs>\<^sub>Rs \<in> f-``{\<zero>\<^sub>S}" using func1_1_L15
      surj_is_fun[OF assms(3)] by auto
    then have "t\<rs>\<^sub>Rs \<in> ?P" using p by auto
    then have "s\<ra>\<^sub>R(t\<rs>\<^sub>Rs) \<in> ?P" using origin_ring.ideal_dest_sum
      P_ideal s(2) by auto
    then have "t\<in>?P" using origin_ring.Ring_ZF_2_L1A(5)
      ss t(2) by auto
  }
  then have "f-``(f``?P) \<subseteq> ?P" by auto
  with R show "f-``target_ring.productIdeal(J, K) \<subseteq> ?P" by auto
  {
    fix t assume as:"t\<in>M``((f-``J)\<times>(f-``K))"
    moreover have "(f-``J)\<times>(f-``K) \<subseteq> R\<times>R" using func1_1_L15[OF surj_is_fun[OF assms(3)]] by auto
    ultimately obtain tj tk where jk:"t=tj\<cdot>\<^sub>Rtk" "tj\<in>f-``J" "tk\<in>f-``K"
      using func_imagedef[of M "R\<times>R" R] origin_ring.ringAssum unfolding IsAring_def IsAmonoid_def
      IsAssociative_def by auto
    from as have tR:"t\<in>R" using func1_1_L6(2)[of M "R\<times>R" R]
      origin_ring.ringAssum unfolding IsAring_def IsAmonoid_def IsAssociative_def
      by auto
    from jk(2) have j:"tj\<in>R" "f`tj \<in>J" using func1_1_L15 surj_is_fun[OF
      assms(3)] by auto
    from jk(3) have k:"tk\<in>R" "f`tk \<in>K" using func1_1_L15 surj_is_fun[OF
      assms(3)] by auto
    from jk(1) have "f`t = f`(tj\<cdot>\<^sub>Rtk)" by auto
    then have ft:"f`t = ((f`tj)\<cdot>\<^sub>S(f`tk))" using homomor_dest_mult
      using j(1) k(1) by auto
    from j(2) k(2) have "\<langle>f`tj,f`tk\<rangle>\<in>J\<times>K" by auto
    moreover have "V:S\<times>S\<rightarrow>S" using target_ring.ringAssum unfolding IsAring_def
      IsAmonoid_def IsAssociative_def by auto
    moreover have "J\<times>K \<subseteq> S\<times>S" using assms using target_ring.ideal_dest_subset
      by auto
    ultimately have "V`\<langle>f ` tj, f ` tk\<rangle> \<in>V``(J\<times>K)"
      using func_imagedef[of V "S\<times>S" S "J\<times>K"] by force
    with ft have "f`t\<in>V``(J\<times>K)" by auto
    then have "f`t\<in>target_ring.productIdeal(J, K)"
      using target_ring.product_in_intersection(3) assms
      by blast
    then have "t\<in>f-``target_ring.productIdeal(J, K)"
      using func1_1_L15 surj_is_fun[OF assms(3)] tR
      by auto
  }
  then have "M `` (f -`` J \<times> f -`` K) \<subseteq> f -`` target_ring.productIdeal(J, K)" by auto
  moreover have id:"(f -``target_ring.productIdeal(J, K)) \<triangleleft>R\<^sub>o"
    apply (rule preimage_ideal) apply (rule target_ring.product_in_intersection(2))
    using assms(1,2) .
  ultimately have "(f -`` J) \<cdot>\<^sub>I (f -`` K) \<subseteq> f -``target_ring.productIdeal(J, K)"
    using origin_ring.generated_ideal_small origin_ring.productIdeal_def[OF ideals]
    by auto
  moreover have "\<zero>\<^sub>S \<in> target_ring.productIdeal(J, K)"
    using target_ring.product_in_intersection(2) assms(1,2)
    target_ring.ideal_dest_zero by auto
  then have "(f -`` {\<zero>\<^sub>S}) \<subseteq> f -``target_ring.productIdeal(J, K)"
     by auto
  ultimately have "((f -`` J) \<cdot>\<^sub>I (f -`` K))\<union>(f -`` {\<zero>\<^sub>S}) \<subseteq> f -``target_ring.productIdeal(J, K)"
    by auto
  then show "((f -`` J) \<cdot>\<^sub>I (f -`` K))+\<^sub>I(f -`` {\<zero>\<^sub>S}) \<subseteq> f -``target_ring.productIdeal(J, K)"
    using origin_ring.generated_ideal_small id
      origin_ring.sumIdeal_def[OF idealJK preimage_ideal(1)[OF target_ring.zero_ideal]]
    by auto
qed

corollary (in ring_homo) prime_ideal_quot_2:
  assumes "J\<triangleleft>R\<^sub>t" "K\<triangleleft>R\<^sub>t" "f\<in>surj(R,S)"
  shows "target_ring.productIdeal(J, K) = f``origin_ring.productIdeal((f-`` J), (f-`` K))"
proof-
  have "f-`` target_ring.productIdeal(J, K) =
 ((f-`` J) \<cdot>\<^sub>I (f-`` K)) +\<^sub>I (ker)" using prime_ideal_quot assms beta by auto
  then have "f``(f-`` target_ring.productIdeal(J, K))
  = f``(((f -`` J) \<cdot>\<^sub>I (f -`` K)) +\<^sub>I (ker))"
    by auto
  moreover have "target_ring.productIdeal(J, K)\<triangleleft>R\<^sub>t"
    using target_ring.product_in_intersection(2)
    assms(1,2) by auto
  then have "target_ring.productIdeal(J, K) \<subseteq> S" using
    target_ring.ideal_dest_subset by auto
  ultimately have A:"target_ring.productIdeal(J, K) =
    f``(((f-`` J) \<cdot>\<^sub>I (f-`` K)) +\<^sub>I(f-``{\<zero>\<^sub>S}))"
    using surj_image_vimage assms(3)
    by auto
  have idealJK:"((f-``J) \<cdot>\<^sub>I (f-``K)) \<triangleleft>R"
    using origin_ring.product_in_intersection(2)
    preimage_ideal assms(1,2) by auto
  with A show "target_ring.productIdeal(J, K) =
    f``((f-`` J) \<cdot>\<^sub>I (f-`` K))" using kernel_empty_image(1)
    preimage_ideal[OF target_ring.zero_ideal] by auto
qed

lemma (in ring_homo) preimage_ideal_prime:
  assumes "J\<triangleleft>\<^sub>pR\<^sub>o" "ker \<subseteq> J" "f\<in>surj(R,S)"
  shows "(f``J)\<triangleleft>\<^sub>pR\<^sub>t"
proof-
  from assms(1,3) have "(f``J)\<triangleleft>R\<^sub>t" using image_ideal_surj
    unfolding origin_ring.primeIdeal_def by auto moreover
  from assms(1) have JT:"J \<subseteq> R" "J \<noteq> R"
    unfolding origin_ring.primeIdeal_def
    using origin_ring.ideal_dest_subset by auto
  {
    assume full:"f``J = S"
    from JT obtain t where t:"t\<in>R-J" by auto
    with assms(3) have "f`t\<in>S"
      using apply_type[OF surj_is_fun] by auto
    with full have "f`t\<in>f``J" by auto
    with assms(3) JT(1) obtain j where j:"j\<in>J" "f`t= f`j"
      using func_imagedef[OF surj_is_fun] by auto
    from j(1) have jt:"j\<in>R" using JT(1) by auto
    then have fj:"f`j\<in>S" using apply_type assms(3)
      unfolding surj_def by auto
    from j(2) have "(f`t)\<rs>\<^sub>S(f`j) = \<zero>\<^sub>S" using
      target_ring.Ring_ZF_1_L3(7) fj by auto
    then have "f`(t\<rs>\<^sub>Rj) =\<zero>\<^sub>S" using homomor_dest_subs
      t jt by auto moreover
    have "t\<rs>\<^sub>Rj \<in>R" using origin_ring.Ring_ZF_1_L4(2)
      t jt by auto
    ultimately have "t\<rs>\<^sub>Rj\<in>f-``{\<zero>\<^sub>S}" using func1_1_L15[OF surj_is_fun]
      assms(3) by auto
    with assms(2) have tjJ:"t\<rs>\<^sub>Rj\<in>J" by auto
    with j(1) have "j\<ra>\<^sub>R(t\<rs>\<^sub>Rj) \<in>J" using assms(1)
      unfolding origin_ring.primeIdeal_def
      using origin_ring.ideal_dest_sum by auto
    then have False using origin_ring.Ring_ZF_2_L1A(5)
      using jt t by auto
  }
  then have "f``J \<noteq> S" by auto moreover
  {
    fix I K assume as:"I\<in>target_ring.ideals" "K\<in>target_ring.ideals"
           "target_ring.productIdeal(I, K) \<subseteq> f``J"
    then have "f `` ((f -`` I) \<cdot>\<^sub>I (f -`` K)) \<subseteq> f``J"
      using prime_ideal_quot_2 assms(3) by auto
    then have "f-``(f `` ((f -`` I) \<cdot>\<^sub>I (f -`` K))) \<subseteq> f-``(f``J)"
      by blast
    moreover have "((f -`` I) \<cdot>\<^sub>I (f -`` K)) \<triangleleft>R"
      using origin_ring.product_in_intersection(2)[OF preimage_ideal(1)
 preimage_ideal(1)]
      as(1,2) by auto
    then have "((f -`` I) \<cdot>\<^sub>I (f -`` K)) \<subseteq> R" using origin_ring.ideal_dest_subset
      by auto
    ultimately have "(f -`` I) \<cdot>\<^sub>I (f -`` K) \<subseteq> f-``(f``J)"
      using func1_1_L9[OF fun, of "(f -`` I) \<cdot>\<^sub>I (f -`` K)"] by auto
    moreover
    have "J \<subseteq> f-``(f``J)" using func1_1_L9 fun assms(1)
      origin_ring.ideal_dest_subset unfolding origin_ring.primeIdeal_def
      by auto moreover
    {
      fix t assume "t\<in>f-``(f``J)"
      then have t:"f`t\<in>f``J" "t\<in>R" using func1_1_L15 fun by auto
      from t(1) obtain s where s:"f`t = f`s" "s\<in>J"
        using func_imagedef fun assms(1)
        origin_ring.ideal_dest_subset unfolding origin_ring.primeIdeal_def
        by auto
      from s(2) assms(1) have ss:"s\<in>R" unfolding origin_ring.primeIdeal_def
        using origin_ring.ideal_dest_subset by auto
      from s(1) have "f`t \<rs>\<^sub>S (f`s) = \<zero>\<^sub>S" using target_ring.Ring_ZF_1_L3(7)[
        OF apply_type[OF fun t(2)]] by auto
      then have "f`(t\<rs>\<^sub>Rs) = \<zero>\<^sub>S" using homomor_dest_subs
        t(2) ss by auto
      moreover have "t\<rs>\<^sub>Rs \<in>R" using ss t(2)
        origin_ring.Ring_ZF_1_L4(2) by auto
      ultimately have "t\<rs>\<^sub>Rs \<in> f-``{\<zero>\<^sub>S}" using func1_1_L15
        fun by auto
      with assms(2) have "t\<rs>\<^sub>Rs \<in> J" by auto
      with s(2) have "s\<ra>\<^sub>R(t\<rs>\<^sub>Rs)\<in>J"
        using assms(1) origin_ring.ideal_dest_sum
        unfolding origin_ring.primeIdeal_def by auto
      then have "t: J" using origin_ring.Ring_ZF_2_L1A(5)
        ss t(2) by auto
    }
    then have "f-``(f``J) \<subseteq> J" by auto
    ultimately have "(f -`` I) \<cdot>\<^sub>I (f -`` K) \<subseteq> J" by auto
    moreover have "(f -`` I) \<in>\<I>" "(f -`` K) \<in>\<I>"
      using as(1,2) preimage_ideal
        origin_ring.ideal_dest_subset by auto
    ultimately have "(f -`` I) \<subseteq> J \<or> (f -`` K) \<subseteq> J"
      using assms(1) unfolding origin_ring.primeIdeal_def by auto
    then have "f``(f -`` I) \<subseteq> f``J \<or> f``(f -`` K) \<subseteq> f``J"
      by auto
    with assms(3) have "I \<subseteq> f``J \<or> K \<subseteq> f``J"
      using surj_image_vimage as(1,2) by auto
  }
  ultimately show ?thesis unfolding target_ring.primeIdeal_def by auto
qed

text\<open>The ideals of the quotient ring are in bijection
with the ideals of the original ring that contain the ideal
by which we made the quotient.\<close>

theorem (in ring_homo) ideal_quot_bijection:
  assumes "f\<in>surj(R,S)"
  defines "idealFun \<equiv> \<lambda>J\<in>target_ring.ideals. f-``J"
  shows "idealFun \<in> bij(target_ring.ideals,{K\<in>\<I>. ker \<subseteq> K})"
  unfolding bij_def inj_def surj_def
proof(safe)
  have "idealFun \<in> target_ring.ideals \<rightarrow> {f-``J. J\<in>target_ring.ideals}"
    unfolding idealFun_def
    using lam_funtype by auto moreover
  {
    fix t assume "t\<in>{f-``J. J\<in>target_ring.ideals}"
    then obtain K where "K\<in>target_ring.ideals" "f-``K = t" by auto
    then have "ker \<subseteq> t" "t\<triangleleft>R" "t \<subseteq> R" using preimage_ideal[of K]
      using func1_1_L3[OF surj_is_fun[OF assms(1)], of K]
      by auto
    then have "t\<in>{K\<in>\<I>. ker \<subseteq> K}" by auto
  }
  then have "{f-``J. J\<in>target_ring.ideals} \<subseteq> {K\<in>\<I>. ker \<subseteq> K}" by blast
  ultimately show "idealFun \<in> target_ring.ideals \<rightarrow> {K\<in>\<I>. ker \<subseteq> K}"
    using func1_1_L1B by auto
  then show "idealFun \<in> target_ring.ideals \<rightarrow> {K\<in>\<I>. ker \<subseteq> K}".
  {
    fix w x assume as:"w\<triangleleft>R\<^sub>t" "x\<triangleleft>R\<^sub>t" "w\<subseteq>S" "x\<subseteq>S" "idealFun ` w = idealFun ` x"
    then have "f-``w = f-``x" unfolding idealFun_def
      using beta by auto
    then have "f``(f-``w) = f``(f-``x)" by auto
    then show "w = x" using surj_image_vimage assms(1) as
      by auto
  }
  {
    fix y assume y:"y\<triangleleft>R" "y\<subseteq>R" "ker \<subseteq> y"
    from y(2) have "y \<subseteq> f-``(f``y)" using func1_1_L9[OF surj_is_fun]
        assms(1) by auto
    moreover
    {
      fix t assume "t\<in>f-``(f``y)"
      then have t:"f`t\<in>f``y" "t\<in>R" using func1_1_L15[OF surj_is_fun]
            assms(1) by auto
      from t(1) y(2) obtain s where s:"s\<in>y" "f`t = f`s"
        using func_imagedef[of f R S y, OF surj_is_fun] assms(1)
        by auto
      from s(1) have "s\<in>R" using y(2) by auto
      with t(2) have E:"f`t : S" "f`s: S" using apply_type[of f R "\<lambda>u. S", OF surj_is_fun]
        assms(1) by auto
      from E(1) s(2) have "(f`t)\<rs>\<^sub>S(f`s) = \<zero>\<^sub>S"
        using target_ring.Ring_ZF_1_L3(7) by auto
      then have "f`(t\<rs>\<^sub>Rs) = \<zero>\<^sub>S" using homomor_dest_subs
        t(2) `s:R` by auto
      moreover from \<open>s\<in>R\<close> have "t\<rs>\<^sub>Rs \<in>R"
        using origin_ring.Ring_ZF_1_L4(2) t(2) by auto
      ultimately have "t\<rs>\<^sub>Rs \<in> f-``{\<zero>\<^sub>S}"
        using func1_1_L15[OF surj_is_fun] assms(1) by auto
      with y(3) have "t\<rs>\<^sub>Rs \<in> y" by auto
      with s(1) have "s\<ra>\<^sub>R(t\<rs>\<^sub>Rs) \<in> y" using
        origin_ring.ideal_dest_sum y(1) by auto
      then have "t\<in>y" using origin_ring.Ring_ZF_2_L1A(5)
        using `s\<in>R` t(2) by auto
    }
    ultimately have "f-``(f``y) = y" by blast moreover
    have "f``y \<subseteq> S" using func1_1_L6(2)[of f R S] assms(1)
      unfolding surj_def by auto moreover
    have "(f``y)\<triangleleft>R\<^sub>t" using image_ideal_surj
      assms(1) y(1) by auto
    ultimately show "\<exists>x\<in>target_ring.ideals. idealFun ` x = y"
      unfolding idealFun_def
      by auto
  }
qed

theorem (in ring_homo) quot_converse:
  defines "idealFun \<equiv> \<lambda>J\<in>target_ring.ideals. f-``J"
  assumes "J\<triangleleft>R" "ker\<subseteq>J" "f:surj(R,S)"
  shows "converse(idealFun)`J = f``J"
proof-
  let ?g="\<lambda>J\<in>{K\<in>\<I>. ker\<subseteq>K}. f``J"
  have "?g\<in>{K\<in>\<I>. ker\<subseteq>K} \<rightarrow> {f``J. J\<in>{K\<in>\<I>. ker\<subseteq>K}}"
    using lam_funtype by auto moreover
  have "{f``J. J\<in>{K\<in>\<I>. ker\<subseteq>K}} \<subseteq> target_ring.ideals"
    using image_ideal_surj target_ring.ideal_dest_subset
    assms(4) by auto
  ultimately have "?g\<in>{K\<in>\<I>. ker\<subseteq>K} \<rightarrow> target_ring.ideals"
    using func1_1_L1B by auto
  have "converse(idealFun)\<in>bij({K\<in>\<I>. ker\<subseteq>K}, target_ring.ideals)"
    using bij_converse_bij ideal_quot_bijection assms(4)
    unfolding idealFun_def by auto
  then have confun:"converse(idealFun):{K\<in>\<I>. ker\<subseteq>K} \<rightarrow> target_ring.ideals"
    unfolding bij_def inj_def by auto
  moreover have J:"J\<in>{K\<in>\<I>. ker\<subseteq>K}" using assms(2,3)
    origin_ring.ideal_dest_subset by auto
  ultimately have ideal:"converse(idealFun)`J \<in> target_ring.ideals"
    using apply_type[of "converse(idealFun)" "{K\<in>\<I>. ker\<subseteq>K}" "\<lambda>q. target_ring.ideals" J]
    by auto
  then have "?g`(idealFun`(converse(idealFun)`J)) = ?g`(f-``(converse(idealFun)`J))"
    using beta unfolding idealFun_def
    by auto moreover
  from preimage_ideal ideal
    have "(f-``(converse(idealFun)`J))\<triangleleft>R" "ker \<subseteq> (f-``(converse(idealFun)`J))" by auto
  then have "?g`(f-``(converse(idealFun)`J)) = f``(f-``(converse(idealFun)`J))"
    using beta origin_ring.ideal_dest_subset by auto
  ultimately have "?g`(idealFun`(converse(idealFun)`J)) = f``(f-``(converse(idealFun)`J))"
    by auto
  then have "?g`(idealFun`(converse(idealFun)`J)) = converse(idealFun)`J"
    using surj_image_vimage assms(4) ideal by auto
  then have "?g`J = converse(idealFun)`J"
    using right_inverse_lemma[of idealFun target_ring.ideals
        "{K \<in> \<I> . ker \<subseteq> K}" "{K \<in> \<I> . ker \<subseteq> K}" J ] J
    confun bij_is_fun[OF ideal_quot_bijection] assms(4)
    unfolding idealFun_def by auto
  then show ?thesis using beta J by auto
qed

text\<open>Since the map is surjective, this bijection
restricts to prime ideals on both sides.\<close>

corollary (in ring_homo) prime_ideal_quot_3:
  assumes "K\<triangleleft>R\<^sub>t" "f:surj(R,S)"
  shows "K\<triangleleft>\<^sub>pR\<^sub>t \<longleftrightarrow> ((f-``K)\<triangleleft>\<^sub>pR\<^sub>o)"
proof
  {
    assume as:"K\<triangleleft>\<^sub>pR\<^sub>t"
    then have "(f-``K)\<triangleleft>\<^sub>pR\<^sub>o" using preimage_prime_ideal_surj
      assms(2) by auto
    then show "(f-``K)\<triangleleft>\<^sub>pR\<^sub>o"
      using beta[of K target_ring.ideals]
      using target_ring.ideal_dest_subset[of K] as
      unfolding target_ring.primeIdeal_def by auto
  } moreover
  {
    assume as:"(f-``K)\<triangleleft>\<^sub>pR\<^sub>o"
    from assms(1) have "K\<triangleleft>R\<^sub>t". moreover
    {
      assume "K=S"
      then have "f-``K = f-``S" by auto
      then have "f-``K = R" using func1_1_L4
        assms(2) unfolding surj_def by auto
      with as have False unfolding origin_ring.primeIdeal_def by auto
    }
    then have "K\<noteq>S" by auto moreover
    {
      fix J P assume jp:"J\<in>target_ring.ideals"
        "P\<in>target_ring.ideals"
        "target_ring.productIdeal(J, P) \<subseteq> K"
      have sub:"((f -`` J) \<cdot>\<^sub>I (f -`` P)) \<union> ker \<subseteq> R"
        using origin_ring.ideal_dest_subset
        origin_ring.product_in_intersection(2)
        preimage_ideal target_ring.zero_ideal
        jp by auto
      from jp(3) have "f -``target_ring.productIdeal(J, P) \<subseteq> f -``K"
        by auto
      with jp(1,2) have A:"((f -`` J) \<cdot>\<^sub>I (f -`` P)) +\<^sub>I (ker) \<subseteq> f -``K"
        using prime_ideal_quot assms(2)
        by auto moreover
      have j:"J\<triangleleft>R\<^sub>t" and p:"P\<triangleleft>R\<^sub>t" using jp(1,2) by auto
      then have "(f -`` J) \<cdot>\<^sub>I (f -`` P) \<union> ker \<subseteq> R"
        using origin_ring.ideal_dest_subset[OF origin_ring.product_in_intersection(2)
            [OF preimage_ideal(1) preimage_ideal(1)]]
            origin_ring.ideal_dest_subset[OF preimage_ideal(1)[OF target_ring.zero_ideal]]
        by auto
      with A have "((f -`` J) \<cdot>\<^sub>I (f -`` P)) \<subseteq> f -``K"
        unfolding origin_ring.sumIdeal_def[OF origin_ring.product_in_intersection(2)
            [OF preimage_ideal(1)[OF j] preimage_ideal(1)[OF p]]
            preimage_ideal(1)[OF target_ring.zero_ideal]] using
            origin_ring.generated_ideal_contains_set[of "(f -`` J) \<cdot>\<^sub>I (f -`` P) \<union> ker"]
            by auto
      moreover have "f -`` J \<in>\<I>" "f -`` P \<in>\<I>"
        using preimage_ideal
        origin_ring.ideal_dest_subset jp(1,2) by auto
      ultimately have "f -`` J \<subseteq> f -`` K \<or> f -`` P \<subseteq> f -`` K"
        using as unfolding origin_ring.primeIdeal_def by auto
      then have "f``(f -`` J) \<subseteq> f``(f -`` K) \<or> f``(f -`` P) \<subseteq> f``(f -`` K)"
        by blast
      then have "J \<subseteq> K \<or> P \<subseteq> K" using assms(2)
        surj_image_vimage jp(1,2) assms target_ring.ideal_dest_subset
        by auto
    }
    ultimately show "K\<triangleleft>\<^sub>pR\<^sub>t"
      unfolding target_ring.primeIdeal_def by auto
  }
qed

corollary (in ring_homo) bij_prime_ideals:
  defines "idealFun \<equiv> \<lambda>J\<in>target_ring.ideals. f-``J"
  assumes "f:surj(R,S)"
  shows "restrict(idealFun,{J\<in>Pow(S). J\<triangleleft>\<^sub>pR\<^sub>t})\<in>bij({J\<in>Pow(S). J\<triangleleft>\<^sub>pR\<^sub>t}, {J\<in>Pow(R). ker\<subseteq>J \<and> (J\<triangleleft>\<^sub>pR)})"
proof-
  have "{J\<in>Pow(S). J\<triangleleft>\<^sub>pR\<^sub>t} \<subseteq> target_ring.ideals"
    unfolding target_ring.primeIdeal_def by auto
  then have rest_bij:"restrict(idealFun,{J\<in>Pow(S). J\<triangleleft>\<^sub>pR\<^sub>t})\<in>bij({J\<in>Pow(S). J\<triangleleft>\<^sub>pR\<^sub>t}, idealFun``{J\<in>Pow(S). J\<triangleleft>\<^sub>pR\<^sub>t})"
    using restrict_bij assms(2)
    ideal_quot_bijection unfolding bij_def
    idealFun_def by auto
  {
    fix t assume t:"t\<in>idealFun``{J\<in>Pow(S). J\<triangleleft>\<^sub>pR\<^sub>t}"
    have sub:"{J\<in>Pow(S). J\<triangleleft>\<^sub>pR\<^sub>t} \<subseteq> target_ring.ideals"
      unfolding target_ring.primeIdeal_def by auto
    from t obtain q where q:"q\<in>{J\<in>Pow(S). J\<triangleleft>\<^sub>pR\<^sub>t}" "t=idealFun`q"
      using assms(2) func_imagedef[OF bij_is_fun[OF ideal_quot_bijection] sub]
      unfolding idealFun_def by auto
    note q(1) moreover
    then have "q\<in>target_ring.ideals" unfolding
      target_ring.primeIdeal_def by auto moreover
    with q(2) have "t = f-``q" "ker\<subseteq>t" "t\<triangleleft>R" unfolding idealFun_def
      using beta
      apply_type[OF ideal_quot_bijection[THEN bij_is_fun], of q] assms(2) by auto
    ultimately have "t\<triangleleft>R" "t\<triangleleft>\<^sub>pR" "ker\<subseteq>t" using assms(2) prime_ideal_quot_3
      by auto
  }
  then have "idealFun `` Collect(Pow(S), prime_ideal_target) \<subseteq> {t\<in>Pow(R). ker\<subseteq>t \<and> (t\<triangleleft>\<^sub>pR)}"
    using origin_ring.ideal_dest_subset by blast moreover
  {
    fix t assume "t\<in>{t\<in>Pow(R). ker\<subseteq>t \<and> (t\<triangleleft>\<^sub>pR)}"
    then have t:"t\<in>Pow(R)" "ker\<subseteq>t" "t\<triangleleft>\<^sub>pR" by auto
    then have tSet:"t\<in>{t\<in>\<I>. ker \<subseteq> t}" unfolding origin_ring.primeIdeal_def by auto
    have "converse(idealFun)\<in>bij({t\<in>\<I>. ker \<subseteq> t}, target_ring.ideals)"
      using ideal_quot_bijection[OF assms(2)] bij_converse_bij unfolding idealFun_def
      by auto
    with tSet have cont:"converse(idealFun)`t \<in> target_ring.ideals"
      using apply_type[OF bij_is_fun] by blast moreover
    from tSet have eq:"idealFun`(converse(idealFun)`t) = t"
      using ideal_quot_bijection assms(2) unfolding idealFun_def
      using right_inverse_bij by blast
    ultimately have "f-``(converse(idealFun)`t) = t"
      using beta unfolding idealFun_def by auto
    with t(3) have "(converse(idealFun)`t) \<triangleleft>\<^sub>pR\<^sub>t"
      using prime_ideal_quot_3 cont assms(2) by auto
    then have "(converse(idealFun)`t) \<triangleleft>\<^sub>pR\<^sub>t" "(converse(idealFun)`t) \<subseteq> S"
      unfolding target_ring.primeIdeal_def
      using target_ring.ideal_dest_subset by auto
    then have elem:"converse(idealFun)`t\<in>{q\<in>Pow(S). q\<triangleleft>\<^sub>pR\<^sub>t}"
      by auto
    have sub:"{q\<in>Pow(S). q\<triangleleft>\<^sub>pR\<^sub>t} \<subseteq> target_ring.ideals"
      unfolding target_ring.primeIdeal_def by auto
    have "t\<in>idealFun``Collect(Pow(S), prime_ideal_target)"
      using assms(2) func_imagedef[OF ideal_quot_bijection[THEN bij_is_fun] sub] unfolding idealFun_def
      using eq elem unfolding idealFun_def by auto
  }
  then have "{t\<in>Pow(R). ker\<subseteq>t \<and> (t\<triangleleft>\<^sub>pR)} \<subseteq> idealFun``Collect(Pow(S), prime_ideal_target)" by auto
  ultimately
  have "{t\<in>Pow(R). ker\<subseteq>t \<and> (t\<triangleleft>\<^sub>pR)} = idealFun``Collect(Pow(S), prime_ideal_target)"
    by auto
  with rest_bij show ?thesis by auto
qed

end


theory Complex_Residues
  imports Complex_Singularities
begin

subsection \<open>Definition of residues\<close>

text\<open>Wenda Li and LC Paulson (2016). A Formal Proof of Cauchy's Residue Theorem.
    Interactive Theorem Proving\<close>

definition\<^marker>\<open>tag important\<close> residue :: "(complex \<Rightarrow> complex) \<Rightarrow> complex \<Rightarrow> complex" where
  "residue f z = (SOME int. \<exists>e>0. \<forall>\<epsilon>>0. \<epsilon><e
    \<longrightarrow> (f has_contour_integral 2*pi* \<i> *int) (circlepath z \<epsilon>))"

lemma residue_cong:
  assumes eq: "eventually (\<lambda>z. f z = g z) (at z)" and "z = z'"
  shows   "residue f z = residue g z'"
proof -
  from assms have eq': "eventually (\<lambda>z. g z = f z) (at z)"
    by (simp add: eq_commute)
  let ?P = "\<lambda>f c e. (\<forall>\<epsilon>>0. \<epsilon> < e \<longrightarrow>
   (f has_contour_integral of_real (2 * pi) * \<i> * c) (circlepath z \<epsilon>))"
  have "residue f z = residue g z" unfolding residue_def
  proof (rule Eps_cong)
    fix c :: complex
    have "\<exists>e>0. ?P g c e"
      if "\<exists>e>0. ?P f c e" and "eventually (\<lambda>z. f z = g z) (at z)" for f g
    proof -
      from that(1) obtain e where e: "e > 0" "?P f c e"
        by blast
      from that(2) obtain e' where e': "e' > 0" "\<And>z'. z' \<noteq> z \<Longrightarrow> dist z' z < e' \<Longrightarrow> f z' = g z'"
        unfolding eventually_at by blast
      have "?P g c (min e e')"
      proof (intro allI exI impI, goal_cases)
        case (1 \<epsilon>)
        hence "(f has_contour_integral of_real (2 * pi) * \<i> * c) (circlepath z \<epsilon>)"
          using e(2) by auto
        thus ?case
        proof (rule has_contour_integral_eq)
          fix z' assume "z' \<in> path_image (circlepath z \<epsilon>)"
          hence "dist z' z < e'" and "z' \<noteq> z"
            using 1 by (auto simp: dist_commute)
          with e'(2)[of z'] show "f z' = g z'" by simp
        qed
      qed
      moreover from e and e' have "min e e' > 0" by auto
      ultimately show ?thesis by blast
    qed
    from this[OF _ eq] and this[OF _ eq']
      show "(\<exists>e>0. ?P f c e) \<longleftrightarrow> (\<exists>e>0. ?P g c e)"
      by blast
  qed
  with assms show ?thesis by simp
qed

lemma contour_integral_circlepath_eq:
  assumes "open s" and f_holo:"f holomorphic_on (s-{z})" and "0<e1" "e1\<le>e2"
    and e2_cball:"cball z e2 \<subseteq> s"
  shows
    "f contour_integrable_on circlepath z e1"
    "f contour_integrable_on circlepath z e2"
    "contour_integral (circlepath z e2) f = contour_integral (circlepath z e1) f"
proof -
  define l where "l \<equiv> linepath (z+e2) (z+e1)"
  have [simp]:"valid_path l" "pathstart l=z+e2" "pathfinish l=z+e1" unfolding l_def by auto
  have "e2>0" using \<open>e1>0\<close> \<open>e1\<le>e2\<close> by auto
  have zl_img:"z\<notin>path_image l"
    proof
      assume "z \<in> path_image l"
      then have "e2 \<le> cmod (e2 - e1)"
        using segment_furthest_le[of z "z+e2" "z+e1" "z+e2",simplified] \<open>e1>0\<close> \<open>e2>0\<close> unfolding l_def
        by (auto simp add:closed_segment_commute)
      thus False using \<open>e2>0\<close> \<open>e1>0\<close> \<open>e1\<le>e2\<close>
        apply (subst (asm) norm_of_real)
        by auto
    qed
  define g where "g \<equiv> circlepath z e2 +++ l +++ reversepath (circlepath z e1) +++ reversepath l"
  show [simp]: "f contour_integrable_on circlepath z e2" "f contour_integrable_on (circlepath z e1)"
    proof -
      show "f contour_integrable_on circlepath z e2"
        apply (intro contour_integrable_continuous_circlepath[OF
                continuous_on_subset[OF holomorphic_on_imp_continuous_on[OF f_holo]]])
        using \<open>e2>0\<close> e2_cball by auto
      show "f contour_integrable_on (circlepath z e1)"
        apply (intro contour_integrable_continuous_circlepath[OF
                      continuous_on_subset[OF holomorphic_on_imp_continuous_on[OF f_holo]]])
        using \<open>e1>0\<close> \<open>e1\<le>e2\<close> e2_cball by auto
    qed
  have [simp]:"f contour_integrable_on l"
    proof -
      have "closed_segment (z + e2) (z + e1) \<subseteq> cball z e2" using \<open>e2>0\<close> \<open>e1>0\<close> \<open>e1\<le>e2\<close>
        by (intro closed_segment_subset,auto simp add:dist_norm)
      hence "closed_segment (z + e2) (z + e1) \<subseteq> s - {z}" using zl_img e2_cball unfolding l_def
        by auto
      then show "f contour_integrable_on l" unfolding l_def
        apply (intro contour_integrable_continuous_linepath[OF
                      continuous_on_subset[OF holomorphic_on_imp_continuous_on[OF f_holo]]])
        by auto
    qed
  let ?ig="\<lambda>g. contour_integral g f"
  have "(f has_contour_integral 0) g"
    proof (rule Cauchy_theorem_global[OF _ f_holo])
      show "open (s - {z})" using \<open>open s\<close> by auto
      show "valid_path g" unfolding g_def l_def by auto
      show "pathfinish g = pathstart g" unfolding g_def l_def by auto
    next
      have path_img:"path_image g \<subseteq> cball z e2"
        proof -
          have "closed_segment (z + e2) (z + e1) \<subseteq> cball z e2" using \<open>e2>0\<close> \<open>e1>0\<close> \<open>e1\<le>e2\<close>
            by (intro closed_segment_subset,auto simp add:dist_norm)
          moreover have "sphere z \<bar>e1\<bar> \<subseteq> cball z e2" using \<open>e2>0\<close> \<open>e1\<le>e2\<close> \<open>e1>0\<close> by auto
          ultimately show ?thesis unfolding g_def l_def using \<open>e2>0\<close>
            by (simp add: path_image_join closed_segment_commute)
        qed
      show "path_image g \<subseteq> s - {z}"
        proof -
          have "z\<notin>path_image g" using zl_img
            unfolding g_def l_def by (auto simp add: path_image_join closed_segment_commute)
          moreover note \<open>cball z e2 \<subseteq> s\<close> and path_img
          ultimately show ?thesis by auto
        qed
      show "winding_number g w = 0" when"w \<notin> s - {z}" for w
        proof -
          have "winding_number g w = 0" when "w\<notin>s" using that e2_cball
            apply (intro winding_number_zero_outside[OF _ _ _ _ path_img])
            by (auto simp add:g_def l_def)
          moreover have "winding_number g z=0"
            proof -
              let ?Wz="\<lambda>g. winding_number g z"
              have "?Wz g = ?Wz (circlepath z e2) + ?Wz l + ?Wz (reversepath (circlepath z e1))
                  + ?Wz (reversepath l)"
                using \<open>e2>0\<close> \<open>e1>0\<close> zl_img unfolding g_def l_def
                by (subst winding_number_join,auto simp add:path_image_join closed_segment_commute)+
              also have "... = ?Wz (circlepath z e2) + ?Wz (reversepath (circlepath z e1))"
                using zl_img
                apply (subst (2) winding_number_reversepath)
                by (auto simp add:l_def closed_segment_commute)
              also have "... = 0"
                proof -
                  have "?Wz (circlepath z e2) = 1" using \<open>e2>0\<close>
                    by (auto intro: winding_number_circlepath_centre)
                  moreover have "?Wz (reversepath (circlepath z e1)) = -1" using \<open>e1>0\<close>
                    apply (subst winding_number_reversepath)
                    by (auto intro: winding_number_circlepath_centre)
                  ultimately show ?thesis by auto
                qed
              finally show ?thesis .
            qed
          ultimately show ?thesis using that by auto
        qed
    qed
  then have "0 = ?ig g" using contour_integral_unique by simp
  also have "... = ?ig (circlepath z e2) + ?ig l + ?ig (reversepath (circlepath z e1))
      + ?ig (reversepath l)"
    unfolding g_def
    by (auto simp add:contour_integrable_reversepath_eq)
  also have "... = ?ig (circlepath z e2)  - ?ig (circlepath z e1)"
    by (auto simp add:contour_integral_reversepath)
  finally show "contour_integral (circlepath z e2) f = contour_integral (circlepath z e1) f"
    by simp
qed

lemma base_residue:
  assumes "open s" "z\<in>s" "r>0" and f_holo:"f holomorphic_on (s - {z})"
    and r_cball:"cball z r \<subseteq> s"
  shows "(f has_contour_integral 2 * pi * \<i> * (residue f z)) (circlepath z r)"
proof -
  obtain e where "e>0" and e_cball:"cball z e \<subseteq> s"
    using open_contains_cball[of s] \<open>open s\<close> \<open>z\<in>s\<close> by auto
  define c where "c \<equiv> 2 * pi * \<i>"
  define i where "i \<equiv> contour_integral (circlepath z e) f / c"
  have "(f has_contour_integral c*i) (circlepath z \<epsilon>)" when "\<epsilon>>0" "\<epsilon><e" for \<epsilon>
    proof -
      have "contour_integral (circlepath z e) f = contour_integral (circlepath z \<epsilon>) f"
          "f contour_integrable_on circlepath z \<epsilon>"
          "f contour_integrable_on circlepath z e"
        using \<open>\<epsilon><e\<close>
        by (intro contour_integral_circlepath_eq[OF \<open>open s\<close> f_holo \<open>\<epsilon>>0\<close> _ e_cball],auto)+
      then show ?thesis unfolding i_def c_def
        by (auto intro:has_contour_integral_integral)
    qed
  then have "\<exists>e>0. \<forall>\<epsilon>>0. \<epsilon><e \<longrightarrow> (f has_contour_integral c * (residue f z)) (circlepath z \<epsilon>)"
    unfolding residue_def c_def
    apply (rule_tac someI[of _ i],intro  exI[where x=e])
    by (auto simp add:\<open>e>0\<close> c_def)
  then obtain e' where "e'>0"
      and e'_def:"\<forall>\<epsilon>>0. \<epsilon><e' \<longrightarrow> (f has_contour_integral c * (residue f z)) (circlepath z \<epsilon>)"
    by auto
  let ?int="\<lambda>e. contour_integral (circlepath z e) f"
  define  \<epsilon> where "\<epsilon> \<equiv> Min {r,e'} / 2"
  have "\<epsilon>>0" "\<epsilon>\<le>r" "\<epsilon><e'" using \<open>r>0\<close> \<open>e'>0\<close> unfolding \<epsilon>_def by auto
  have "(f has_contour_integral c * (residue f z)) (circlepath z \<epsilon>)"
    using e'_def[rule_format,OF \<open>\<epsilon>>0\<close> \<open>\<epsilon><e'\<close>] .
  then show ?thesis unfolding c_def
    using contour_integral_circlepath_eq[OF \<open>open s\<close> f_holo \<open>\<epsilon>>0\<close> \<open>\<epsilon>\<le>r\<close> r_cball]
    by (auto elim: has_contour_integral_eqpath[of _ _ "circlepath z \<epsilon>" "circlepath z r"])
qed

lemma residue_holo:
  assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s"
  shows "residue f z = 0"
proof -
  define c where "c \<equiv> 2 * pi * \<i>"
  obtain e where "e>0" and e_cball:"cball z e \<subseteq> s" using \<open>open s\<close> \<open>z\<in>s\<close>
    using open_contains_cball_eq by blast
  have "(f has_contour_integral c*residue f z) (circlepath z e)"
    using f_holo
    by (auto intro: base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c_def])
  moreover have "(f has_contour_integral 0) (circlepath z e)"
    using f_holo e_cball \<open>e>0\<close>
    by (auto intro: Cauchy_theorem_convex_simple[of _ "cball z e"])
  ultimately have "c*residue f z =0"
    using has_contour_integral_unique by blast
  thus ?thesis unfolding c_def  by auto
qed

lemma residue_const:"residue (\<lambda>_. c) z = 0"
  by (intro residue_holo[of "UNIV::complex set"],auto intro:holomorphic_intros)

lemma residue_add:
  assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
      and g_holo:"g holomorphic_on s - {z}"
  shows "residue (\<lambda>z. f z + g z) z= residue f z + residue g z"
proof -
  define c where "c \<equiv> 2 * pi * \<i>"
  define fg where "fg \<equiv> (\<lambda>z. f z+g z)"
  obtain e where "e>0" and e_cball:"cball z e \<subseteq> s" using \<open>open s\<close> \<open>z\<in>s\<close>
    using open_contains_cball_eq by blast
  have "(fg has_contour_integral c * residue fg z) (circlepath z e)"
    unfolding fg_def using f_holo g_holo
    apply (intro base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c_def])
    by (auto intro:holomorphic_intros)
  moreover have "(fg has_contour_integral c*residue f z + c* residue g z) (circlepath z e)"
    unfolding fg_def using f_holo g_holo
    by (auto intro: has_contour_integral_add base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c_def])
  ultimately have "c*(residue f z + residue g z) = c * residue fg z"
    using has_contour_integral_unique by (auto simp add:distrib_left)
  thus ?thesis unfolding fg_def
    by (auto simp add:c_def)
qed

lemma residue_lmul:
  assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
  shows "residue (\<lambda>z. c * (f z)) z= c * residue f z"
proof (cases "c=0")
  case True
  thus ?thesis using residue_const by auto
next
  case False
  define c' where "c' \<equiv> 2 * pi * \<i>"
  define f' where "f' \<equiv> (\<lambda>z. c * (f z))"
  obtain e where "e>0" and e_cball:"cball z e \<subseteq> s" using \<open>open s\<close> \<open>z\<in>s\<close>
    using open_contains_cball_eq by blast
  have "(f' has_contour_integral c' * residue f' z) (circlepath z e)"
    unfolding f'_def using f_holo
    apply (intro base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c'_def])
    by (auto intro:holomorphic_intros)
  moreover have "(f' has_contour_integral c * (c' * residue f z)) (circlepath z e)"
    unfolding f'_def using f_holo
    by (auto intro: has_contour_integral_lmul
      base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c'_def])
  ultimately have "c' * residue f' z  = c * (c' * residue f z)"
    using has_contour_integral_unique by auto
  thus ?thesis unfolding f'_def c'_def using False
    by (auto simp add:field_simps)
qed

lemma residue_rmul:
  assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
  shows "residue (\<lambda>z. (f z) * c) z= residue f z * c"
using residue_lmul[OF assms,of c] by (auto simp add:algebra_simps)

lemma residue_div:
  assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
  shows "residue (\<lambda>z. (f z) / c) z= residue f z / c "
using residue_lmul[OF assms,of "1/c"] by (auto simp add:algebra_simps)

lemma residue_neg:
  assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
  shows "residue (\<lambda>z. - (f z)) z= - residue f z"
using residue_lmul[OF assms,of "-1"] by auto

lemma residue_diff:
  assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
      and g_holo:"g holomorphic_on s - {z}"
  shows "residue (\<lambda>z. f z - g z) z= residue f z - residue g z"
using residue_add[OF assms(1,2,3),of "\<lambda>z. - g z"] residue_neg[OF assms(1,2,4)]
by (auto intro:holomorphic_intros g_holo)

lemma residue_simple:
  assumes "open s" "z\<in>s" and f_holo:"f holomorphic_on s"
  shows "residue (\<lambda>w. f w / (w - z)) z = f z"
proof -
  define c where "c \<equiv> 2 * pi * \<i>"
  define f' where "f' \<equiv> \<lambda>w. f w / (w - z)"
  obtain e where "e>0" and e_cball:"cball z e \<subseteq> s" using \<open>open s\<close> \<open>z\<in>s\<close>
    using open_contains_cball_eq by blast
  have "(f' has_contour_integral c * f z) (circlepath z e)"
    unfolding f'_def c_def using \<open>e>0\<close> f_holo e_cball
    by (auto intro!: Cauchy_integral_circlepath_simple holomorphic_intros)
  moreover have "(f' has_contour_integral c * residue f' z) (circlepath z e)"
    unfolding f'_def using f_holo
    apply (intro base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c_def])
    by (auto intro!:holomorphic_intros)
  ultimately have "c * f z = c * residue f' z"
    using has_contour_integral_unique by blast
  thus ?thesis unfolding c_def f'_def  by auto
qed

lemma residue_simple':
  assumes s: "open s" "z \<in> s" and holo: "f holomorphic_on (s - {z})"
      and lim: "((\<lambda>w. f w * (w - z)) \<longlongrightarrow> c) (at z)"
  shows   "residue f z = c"
proof -
  define g where "g = (\<lambda>w. if w = z then c else f w * (w - z))"
  from holo have "(\<lambda>w. f w * (w - z)) holomorphic_on (s - {z})" (is "?P")
    by (force intro: holomorphic_intros)
  also have "?P \<longleftrightarrow> g holomorphic_on (s - {z})"
    by (intro holomorphic_cong refl) (simp_all add: g_def)
  finally have *: "g holomorphic_on (s - {z})" .

  note lim
  also have "(\<lambda>w. f w * (w - z)) \<midarrow>z\<rightarrow> c \<longleftrightarrow> g \<midarrow>z\<rightarrow> g z"
    by (intro filterlim_cong refl) (simp_all add: g_def [abs_def] eventually_at_filter)
  finally have **: "g \<midarrow>z\<rightarrow> g z" .

  have g_holo: "g holomorphic_on s"
    by (rule no_isolated_singularity'[where K = "{z}"])
       (insert assms * **, simp_all add: at_within_open_NO_MATCH)
  from s and this have "residue (\<lambda>w. g w / (w - z)) z = g z"
    by (rule residue_simple)
  also have "\<forall>\<^sub>F za in at z. g za / (za - z) = f za"
    unfolding eventually_at by (auto intro!: exI[of _ 1] simp: field_simps g_def)
  hence "residue (\<lambda>w. g w / (w - z)) z = residue f z"
    by (intro residue_cong refl)
  finally show ?thesis
    by (simp add: g_def)
qed

lemma residue_holomorphic_over_power:
  assumes "open A" "z0 \<in> A" "f holomorphic_on A"
  shows   "residue (\<lambda>z. f z / (z - z0) ^ Suc n) z0 = (deriv ^^ n) f z0 / fact n"
proof -
  let ?f = "\<lambda>z. f z / (z - z0) ^ Suc n"
  from assms(1,2) obtain r where r: "r > 0" "cball z0 r \<subseteq> A"
    by (auto simp: open_contains_cball)
  have "(?f has_contour_integral 2 * pi * \<i> * residue ?f z0) (circlepath z0 r)"
    using r assms by (intro base_residue[of A]) (auto intro!: holomorphic_intros)
  moreover have "(?f has_contour_integral 2 * pi * \<i> / fact n * (deriv ^^ n) f z0) (circlepath z0 r)"
    using assms r
    by (intro Cauchy_has_contour_integral_higher_derivative_circlepath)
       (auto intro!: holomorphic_on_subset[OF assms(3)] holomorphic_on_imp_continuous_on)
  ultimately have "2 * pi * \<i> * residue ?f z0 = 2 * pi * \<i> / fact n * (deriv ^^ n) f z0"
    by (rule has_contour_integral_unique)
  thus ?thesis by (simp add: field_simps)
qed

lemma residue_holomorphic_over_power':
  assumes "open A" "0 \<in> A" "f holomorphic_on A"
  shows   "residue (\<lambda>z. f z / z ^ Suc n) 0 = (deriv ^^ n) f 0 / fact n"
  using residue_holomorphic_over_power[OF assms] by simp

theorem residue_fps_expansion_over_power_at_0:
  assumes "f has_fps_expansion F"
  shows   "residue (\<lambda>z. f z / z ^ Suc n) 0 = fps_nth F n"
proof -
  from has_fps_expansion_imp_holomorphic[OF assms] obtain s
    where "open s" "0 \<in> s" "f holomorphic_on s" "\<And>z. z \<in> s \<Longrightarrow> f z = eval_fps F z"
    by auto
  with assms have "residue (\<lambda>z. f z / (z - 0) ^ Suc n) 0 = (deriv ^^ n) f 0 / fact n"
    unfolding has_fps_expansion_def
    by (intro residue_holomorphic_over_power[of s]) (auto simp: zero_ereal_def)
  also from assms have "\<dots> = fps_nth F n"
    by (subst fps_nth_fps_expansion) auto
  finally show ?thesis by simp
qed

lemma residue_pole_order:
  fixes f::"complex \<Rightarrow> complex" and z::complex
  defines "n \<equiv> nat (- zorder f z)" and "h \<equiv> zor_poly f z"
  assumes f_iso:"isolated_singularity_at f z"
    and pole:"is_pole f z"
  shows "residue f z = ((deriv ^^ (n - 1)) h z / fact (n-1))"
proof -
  define g where "g \<equiv> \<lambda>x. if x=z then 0 else inverse (f x)"
  obtain e where [simp]:"e>0" and f_holo:"f holomorphic_on ball z e - {z}"
    using f_iso analytic_imp_holomorphic unfolding isolated_singularity_at_def by blast
  obtain r where "0 < n" "0 < r" and r_cball:"cball z r \<subseteq> ball z e" and h_holo: "h holomorphic_on cball z r"
      and h_divide:"(\<forall>w\<in>cball z r. (w\<noteq>z \<longrightarrow> f w = h w / (w - z) ^ n) \<and> h w \<noteq> 0)"
  proof -
    obtain r where r:"zorder f z < 0" "h z \<noteq> 0" "r>0" "cball z r \<subseteq> ball z e" "h holomorphic_on cball z r"
        "(\<forall>w\<in>cball z r - {z}. f w = h w / (w - z) ^ n \<and> h w \<noteq> 0)"
      using zorder_exist_pole[OF f_holo,simplified,OF \<open>is_pole f z\<close>,folded n_def h_def] by auto
    have "n>0" using \<open>zorder f z < 0\<close> unfolding n_def by simp
    moreover have "(\<forall>w\<in>cball z r. (w\<noteq>z \<longrightarrow> f w = h w / (w - z) ^ n) \<and> h w \<noteq> 0)"
      using \<open>h z\<noteq>0\<close> r(6) by blast
    ultimately show ?thesis using r(3,4,5) that by blast
  qed
  have r_nonzero:"\<And>w. w \<in> ball z r - {z} \<Longrightarrow> f w \<noteq> 0"
    using h_divide by simp
  define c where "c \<equiv> 2 * pi * \<i>"
  define der_f where "der_f \<equiv> ((deriv ^^ (n - 1)) h z / fact (n-1))"
  define h' where "h' \<equiv> \<lambda>u. h u / (u - z) ^ n"
  have "(h' has_contour_integral c / fact (n - 1) * (deriv ^^ (n - 1)) h z) (circlepath z r)"
    unfolding h'_def
    proof (rule Cauchy_has_contour_integral_higher_derivative_circlepath[of z r h z "n-1",
        folded c_def Suc_pred'[OF \<open>n>0\<close>]])
      show "continuous_on (cball z r) h" using holomorphic_on_imp_continuous_on h_holo by simp
      show "h holomorphic_on ball z r" using h_holo by auto
      show " z \<in> ball z r" using \<open>r>0\<close> by auto
    qed
  then have "(h' has_contour_integral c * der_f) (circlepath z r)" unfolding der_f_def by auto
  then have "(f has_contour_integral c * der_f) (circlepath z r)"
    proof (elim has_contour_integral_eq)
      fix x assume "x \<in> path_image (circlepath z r)"
      hence "x\<in>cball z r - {z}" using \<open>r>0\<close> by auto
      then show "h' x = f x" using h_divide unfolding h'_def by auto
    qed
  moreover have "(f has_contour_integral c * residue f z) (circlepath z r)"
    using base_residue[of \<open>ball z e\<close> z,simplified,OF \<open>r>0\<close> f_holo r_cball,folded c_def]
    unfolding c_def by simp
  ultimately have "c * der_f =  c * residue f z" using has_contour_integral_unique by blast
  hence "der_f = residue f z" unfolding c_def by auto
  thus ?thesis unfolding der_f_def by auto
qed

lemma residue_simple_pole:
  assumes "isolated_singularity_at f z0"
  assumes "is_pole f z0" "zorder f z0 = - 1"
  shows   "residue f z0 = zor_poly f z0 z0"
  using assms by (subst residue_pole_order) simp_all

lemma residue_simple_pole_limit:
  assumes "isolated_singularity_at f z0"
  assumes "is_pole f z0" "zorder f z0 = - 1"
  assumes "((\<lambda>x. f (g x) * (g x - z0)) \<longlongrightarrow> c) F"
  assumes "filterlim g (at z0) F" "F \<noteq> bot"
  shows   "residue f z0 = c"
proof -
  have "residue f z0 = zor_poly f z0 z0"
    by (rule residue_simple_pole assms)+
  also have "\<dots> = c"
    apply (rule zor_poly_pole_eqI)
    using assms by auto
  finally show ?thesis .
qed

lemma
  assumes f_holo:"f holomorphic_on s" and g_holo:"g holomorphic_on s"
          and "open s" "connected s" "z \<in> s"
  assumes g_deriv:"(g has_field_derivative g') (at z)"
  assumes "f z \<noteq> 0" "g z = 0" "g' \<noteq> 0"
  shows   porder_simple_pole_deriv: "zorder (\<lambda>w. f w / g w) z = - 1"
    and   residue_simple_pole_deriv: "residue (\<lambda>w. f w / g w) z = f z / g'"
proof -
  have [simp]:"isolated_singularity_at f z" "isolated_singularity_at g z"
    using isolated_singularity_at_holomorphic[OF _ \<open>open s\<close> \<open>z\<in>s\<close>] f_holo g_holo
    by (meson Diff_subset holomorphic_on_subset)+
  have [simp]:"not_essential f z" "not_essential g z"
    unfolding not_essential_def using f_holo g_holo assms(3,5)
    by (meson continuous_on_eq_continuous_at continuous_within holomorphic_on_imp_continuous_on)+
  have g_nconst:"\<exists>\<^sub>F w in at z. g w \<noteq>0 "
  proof (rule ccontr)
    assume "\<not> (\<exists>\<^sub>F w in at z. g w \<noteq> 0)"
    then have "\<forall>\<^sub>F w in nhds z. g w = 0"
      unfolding eventually_at eventually_nhds frequently_at using \<open>g z = 0\<close>
      by (metis open_ball UNIV_I centre_in_ball dist_commute mem_ball)
    then have "deriv g z = deriv (\<lambda>_. 0) z"
      by (intro deriv_cong_ev) auto
    then have "deriv g z = 0" by auto
    then have "g' = 0" using g_deriv DERIV_imp_deriv by blast
    then show False using \<open>g'\<noteq>0\<close> by auto
  qed

  have "zorder (\<lambda>w. f w / g w) z = zorder f z - zorder g z"
  proof -
    have "\<forall>\<^sub>F w in at z. f w \<noteq>0 \<and> w\<in>s"
      apply (rule non_zero_neighbour_alt)
      using assms by auto
    with g_nconst have "\<exists>\<^sub>F w in at z. f w * g w \<noteq> 0"
      by (elim frequently_rev_mp eventually_rev_mp,auto)
    then show ?thesis using zorder_divide[of f z g] by auto
  qed
  moreover have "zorder f z=0"
    apply (rule zorder_zero_eqI[OF f_holo \<open>open s\<close> \<open>z\<in>s\<close>])
    using \<open>f z\<noteq>0\<close> by auto
  moreover have "zorder g z=1"
    apply (rule zorder_zero_eqI[OF g_holo \<open>open s\<close> \<open>z\<in>s\<close>])
    subgoal using assms(8) by auto
    subgoal using DERIV_imp_deriv assms(9) g_deriv by auto
    subgoal by simp
    done
  ultimately show "zorder (\<lambda>w. f w / g w) z = - 1" by auto

  show "residue (\<lambda>w. f w / g w) z = f z / g'"
  proof (rule residue_simple_pole_limit[where g=id and F="at z",simplified])
    show "zorder (\<lambda>w. f w / g w) z = - 1" by fact
    show "isolated_singularity_at (\<lambda>w. f w / g w) z"
      by (auto intro: singularity_intros)
    show "is_pole (\<lambda>w. f w / g w) z"
    proof (rule is_pole_divide)
      have "\<forall>\<^sub>F x in at z. g x \<noteq> 0"
        apply (rule non_zero_neighbour)
        using g_nconst by auto
      moreover have "g \<midarrow>z\<rightarrow> 0"
        using DERIV_isCont assms(8) continuous_at g_deriv by force
      ultimately show "filterlim g (at 0) (at z)" unfolding filterlim_at by simp
      show "isCont f z"
        using assms(3,5) continuous_on_eq_continuous_at f_holo holomorphic_on_imp_continuous_on
        by auto
      show "f z \<noteq> 0" by fact
    qed
    show "filterlim id (at z) (at z)" by (simp add: filterlim_iff)
    have "((\<lambda>w. (f w * (w - z)) / g w) \<longlongrightarrow> f z / g') (at z)"
    proof (rule lhopital_complex_simple)
      show "((\<lambda>w. f w * (w - z)) has_field_derivative f z) (at z)"
        using assms by (auto intro!: derivative_eq_intros holomorphic_derivI[OF f_holo])
      show "(g has_field_derivative g') (at z)" by fact
    qed (insert assms, auto)
    then show "((\<lambda>w. (f w / g w) * (w - z)) \<longlongrightarrow> f z / g') (at z)"
      by (simp add: field_split_simps)
  qed
qed

subsection \<open>Poles and residues of some well-known functions\<close>

(* TODO: add more material here for other functions *)
lemma is_pole_Gamma: "is_pole Gamma (-of_nat n)"
  unfolding is_pole_def using Gamma_poles .

lemma Gamma_residue:
  "residue Gamma (-of_nat n) = (-1) ^ n / fact n"
proof (rule residue_simple')
  show "open (- (\<int>\<^sub>\<le>\<^sub>0 - {-of_nat n}) :: complex set)"
    by (intro open_Compl closed_subset_Ints) auto
  show "Gamma holomorphic_on (- (\<int>\<^sub>\<le>\<^sub>0 - {-of_nat n}) - {- of_nat n})"
    by (rule holomorphic_Gamma) auto
  show "(\<lambda>w. Gamma w * (w - (-of_nat n))) \<midarrow>(-of_nat n)\<rightarrow> (- 1) ^ n / fact n"
    using Gamma_residues[of n] by simp
qed auto

end