import data.list.basic tactic.linarith
import tactic.omega tactic.apply
import list.lemmas.simple

open list

/- head -/

/--If you take the head of the first n+1 elements in reverse order you get the nth element-/
lemma head_reverse_take {A : list ℤ} {n : ℕ } (h : n < length A):
  head (reverse (take (n + 1) A)) = nth_le A n h :=
begin
  /- we want to change the LHS to something involving nth_le (to
     nth_le (reverse (take (n + 1) A)) 0 (H1 : 0 < length (reverse (take (n + 1) A))
     using nth_le_zero)
     For that we need the corresponding argument H1 for nth_le-/
  have H1 : 0 < length (reverse (take (n + 1) A)),
   { rw length_reverse, -- length (reverse (take (n + 1) A)) = length (take (n + 1) A)
     rw length_take, -- length (take (n + 1) A) = min (n + 1) (length A)
     apply lt_min, -- lemma says, for all a,b,c, a < b → a < c → a < min b c
       -- focused goal: 0 < n + 1
       exact nat.succ_pos n, -- lemma says any successor of a natural number is positive
     -- focused goal: 0 < length A
     refine lt_of_le_of_lt _ h, -- using that 0 ≤ n and n < length A imply 0 < length A
     exact zero_le n, --  0 ≤ n
},
  -- now we have H1 and nth_le_zero gives the following
  have H : head (reverse (take (n + 1) A)) = nth_le (reverse (take (n + 1) A)) 0 H1,
    rw nth_le_zero,
  rw H,

rw nth_le_reverse' _ _ _ _, -- see list.lemmas.simple
  swap, /- first prove necessary hypothesis for nth_le_reverse' that
          length (take (n + 1) A) - 1 - 0 < length (take (n + 1) A)-/
  { rw length_take, -- length (take (n + 1) A) = min (n + 1) (length A)
    rw nat.sub_zero,
    apply buffer.lt_aux_2, --min (n + 1) (length A) > 0 → min (n + 1) (length A) - 1 < min (n + 1) (length A)
    /- to show min (n + 1) (length A) > 0, we can show that 0 < (n + 1) and n + 1 ≤ length A
        the second one is h-/
    have H : 0 < (n + 1) := by norm_num, -- the first one is true for any n in ℕ
    apply lt_of_lt_of_le H, -- n + 1 ≤ min (n + 1) (length A) → min (n + 1) (length A) > 0
    apply le_min (le_refl _), -- n + 1 ≤ length A  → n + 1 ≤ min (n + 1) (length A)
    exact h },
  -- other goal :  nth_le (take (n + 1) A) (min (n + 1) (length A) - 1 - 0) _ = nth_le A n h
  simp only [length_take], -- simp only because of nth_le
  rw nth_le_take, -- see list.lemmas.simple
    swap, /- solve necessary hypothesis for nth_le_take first, which is
             min (n + 1) (length A) - 1 - 0 < length A-/
  { rw nat.sub_zero, -- get rid of (- 0)
    rw nat.sub_lt_right_iff_lt_add, /- if 1 ≤ min (n + 1) (length A), then min (n + 1) (length A) - 1 < length A ↔ min (n + 1) (length A) < length A + 1
                                       (hyothesis 1 ≤ min (n + 1) (length A) necessary beause 0 - 1 = 0) -/
    { apply lt_of_le_of_lt _ (nat.lt_succ_self _), -- min (n + 1) (length A) ≤ length A → min (n + 1) (length A) < length A + 1
      apply min_le_right}, -- lemma says : min a b ≤ b for all a,b of the same type

    -- now need to prove 1 ≤ min (n + 1) (length A) because of nat.sub_lt_right_iff_lt_add
    apply le_min, -- 1 ≤ n + 1 → 1 ≤ length A → 1 ≤ min (n + 1) (length A)
    -- prove 1 ≤ n + 1
    {exact nat.le_add_left 1 n},
    -- prove 1 ≤ length A
    {show 0 < length A,
     refine lt_of_le_of_lt _ h, -- just like line 26
     exact nat.zero_le n,}
  },

  -- back to main goal : nth_le A (min (n + 1) (length A) - 1 - 0) ?m_1 = nth_le A n h
  congr', -- suffices to show : min (n + 1) (length A) - 1 - 0 = n
  rw nat.sub_zero, -- get rid of (- 0)
  have H3 : n + 1 ≤ length A,
    {exact h},
  rw min_eq_left H3, -- by H3 min (n + 1) (length A) = n + 1
  exact nat.add_sub_cancel n 1,

end

/- remove_nth -/

/--The list with element n removed is the same as the list ccreated by
   appending the list containing all its elements after element n to the
   list containing its elements up to and excluding element n-/
lemma remove_nth_eq_take_append_drop (n : ℕ) (L : list ℤ) :
  remove_nth L n = take n L ++ drop (n + 1) L :=
begin
  rw remove_nth_eq_nth_tail, -- remove_nth L n = modify_nth_tail tail n L
  rw modify_nth_tail_eq_take_drop, -- modify_nth_tail tail n = take n L ++ tail (drop n L)
  rw tail_drop, /- tail (drop n L) = drop (nat.succ n) L,
                   which is definitionally equal to drop (n + 1) L
                   by def of nat.succ-/

  -- other goal : tail nil = nil (hypothesis necessary for modify_nth_tail_eq_take_drop)
  refl, -- true by definition of tail
end

/--changing the order of element removal of a list of integers-/
lemma remove_nth_remove_nth {a b : ℕ } (L : list ℤ)(Ha : a ≤ length L)(Hb : b + 1 ≤ length L):
remove_nth (remove_nth L a) b = if a < (b + 1) then remove_nth (remove_nth L (b+1)) a
else remove_nth (remove_nth L b) (a-1):=
begin
  /- my proof will at some point require a to be psitive, so we prove the case where
     a is 0 separately-/
  cases a,
    -- a = 0
    { rw if_pos (nat.zero_lt_succ _), -- 0 < (b + 1),  because any successor in ℕ is greater than 0
      -- so we need to prove remove_nth (remove_nth L a) b = remove_nth (remove_nth L (b+1)) 0
      rw remove_nth_zero, -- lemma says : for any list A, remove_nth A 0 = tail A
      rw remove_nth_zero,
      cases L with c Lc,
        -- L = nil
        {intros,
        refl}, -- both sides are nil by def of remove_nth and tail
        -- L = (c :: Lc)
        {intros,
        refl}, /- both sides are remove_nth (tail (c :: Lc)) b
                  by def of remove_nth and tail-/
    },

  -- nat.succ a
  split_ifs with ite1, -- now we have to prove each case of the if-then-else-condition
    -- if-case (named ite1) :  nat.succ a < b + 1
    { repeat {rw remove_nth_eq_take_append_drop}, -- see lemma above
      /- get goal : take b (take (nat.succ a) L ++ drop (nat.succ a + 1) L) ++
      drop (b + 1) (take (nat.succ a) L ++ drop (nat.succ a + 1) L) =
      take (nat.succ a) (take (b + 1) L ++ drop (b + 1 + 1) L) ++
      drop (nat.succ a + 1) (take (b + 1) L ++ drop (b + 1 + 1) L)

      we need to simplify this
      We will start by getting rid of appends within drop or take-/

      rw drop_append, /- drop (b + 1) (take (nat.succ a) L ++ drop (nat.succ a + 1) L) =
                        ite (b + 1 ≤ length (take (nat.succ a) L)) (drop (b + 1) (take (nat.succ a) L) ++ drop (nat.succ a + 1) L)
                        (drop (b + 1 - length (take (nat.succ a) L)) (drop (nat.succ a + 1) L))-/
      split_ifs with ite2,
        -- if-case (named ite2) : b < length (take (nat.succ a) L)
          {rw [length_take, lt_min_iff] at ite2, --b < length (take (nat.succ a) L) ↔ b < nat.succ a ∧ b < length L
          cases ite2,
          linarith}, -- gives contradiction between ite1 and b < nat.succ a which Lean can find itself with linarith

        -- else-case (named ite2) : ¬ (b < length (take (nat.succ a) L))
        clear ite2,-- will not need negation of ite2 for this
        rw @take_append _ _ _ (a + 1), /- take (nat.succ a) (take (b + 1) L ++ drop (b + 1 + 1) L)
                                          = ite (a + 1 ≤ length (take (b + 1) L)) (take (a + 1) (take (b + 1) L))
                                            (take (b + 1) L ++ take (a + 1 - length (take (b + 1) L))
                                            (drop (b + 1 + 1) L))-/
        split_ifs with ite3,
          swap,

          -- else-case (named ite3) : ¬ (a < length (take (b + 1) L))
          { push_neg at ite3, -- ite3 is length (take (b + 1) L) ≤ a
            rw [length_take] at ite3, -- ite3 ↔ min (b + 1) (length L) ≤ a
            exfalso, -- gives contradiction between ite3 and ite1
            rw min_eq_left Hb at ite3, -- know (by Hb) that the minimum is b+1
              change a + 1 < _ at ite1,
              linarith, -- after simplifying ite1 Lean can find the contradiction
          },

          -- if-case (named ite3) :  a < length (take (b + 1) L)
          rw take_append,-- get rid of the other append within take
          rw drop_append,-- get rid of the other append within drop

          /- simplifying the if-conditions that came up in the last two lines :
          b ≤ length (take (nat.succ a) L)  and  nat.succ a + 1 ≤ length (take (b + 1) L)-/
          rw length_take,
          rw length_take,
          rw min_eq_left Hb,
          rw min_eq_left Ha,
          rw nat.succ_eq_add_one at *, -- nat.succ a = a + 1 (rewritten in all hypotheses as well)
          -- now they are b ≤ a + 1 and a + 1 + 1 ≤ b + 1 (the second one is true by ite1 : a + 1 < b + 1)
          clear ite3,
          rw if_pos (show a+1+1≤b+1, from ite1), -- second if-condition is true by ite1
          split_ifs with ite4, -- the other we solve by cases

          --if-case (named ite4) : b ≤ a + 1
          { rw le_iff_eq_or_lt at ite4, -- ite4 is b = a + 1 ∨ b < a + 1
            cases ite4,
              swap,

              -- b < a + 1
              {exfalso, -- contradicts ite1
              linarith},

              -- b = a + 1
              {rw ←ite4, -- express everything in terms of b and L
              /- goal is :
                take b (take b L) ++ drop (b + 1 - b) (drop (b + 1) L) =
                take b (take (b + 1) L) ++ (drop (b + 1) (take (b + 1) L) ++ drop (b + 1 + 1) L)-/
              rw take_take, -- take b (take b L) = take (min b b) L
              rw min_self, -- min b b = b
              rw take_take, -- take b (take (b + 1) L) = take (min b (b + 1)) L
              rw min_eq_left, -- min b (b + 1) = b, need to prove b ≤ b + 1 for that
                swap,
                {simp only [zero_le, le_add_iff_nonneg_right]}, -- proves b ≤ b + 1
              congr', /- changes goal to drop (b + 1 - b) (drop (b + 1) L) =
                        drop (b + 1) (take (b + 1) L) ++ drop (b + 1 + 1) L -/
              rw drop_drop, -- drop (b + 1 - b) (drop (b + 1) L) = drop (b + 1 - b + (b + 1)) L
              rw drop_take (b+1) 0 L, -- drop (b + 1) (take (b + 1) L) = take 0 (drop (b + 1) L)
              rw take_zero, -- take 0 (drop (b + 1) L) = nil
              rw nil_append,
              -- goal is now drop (b + 1 - b + (b + 1)) L = drop (b + 1 + 1) L
              simp,}, -- Lean can do this by itself with simp
          },

            --else-case (named ite4) : ¬ (b ≤ a + 1)
            { /- goal is again :
                take (a + 1) L ++ take (b - (a + 1)) (drop (a + 1 + 1) L)
                ++ drop (b + 1 - (a + 1)) (drop (a + 1 + 1) L) =
                take (a + 1) (take (b + 1) L) ++ (drop (a + 1 + 1) (take (b + 1) L)
                ++ drop (b + 1 + 1) L)-/
              rw drop_drop, /- drop (b + 1 - (a + 1)) (drop (a + 1 + 1) L) =
                              drop (b + 1 - (a + 1) + (a + 1 + 1)) L -/
              rw take_take, /- take (a + 1) (take (b + 1) L) =
                                take (min (a + 1) (b + 1)) L-/
              rw min_eq_left (le_of_lt ite1), -- min (a + 1) (b + 1) = a + 1 , because of ite1
              rw ←drop_take, /- take (b - (a + 1)) (drop (a + 1 + 1) L) =
                                drop (a + 1 + 1) (take (a + 1 + 1 + (b - (a + 1))) L) -/

              /- hence have goal :
                take (a + 1) L ++ drop (a + 1 + 1) (take (a + 1 + 1 + (b - (a + 1))) L)
                ++ drop (b + 1 - (a + 1) + (a + 1 + 1)) L =
                take (a + 1) L ++ (drop (a + 1 + 1) (take (b + 1) L) ++ drop (b + 1 + 1) L)

                Just need to show the terms in brackets are the same on both sides-/
              have p1 : b + 1 - (a + 1) + (a + 1 + 1) = b + 1 + 1,
                  {clear Hb Ha, -- because omega peculiarly does not work otherwise
                  omega}, -- Lean can solve this by itself
              rw p1,
              clear p1,
              have p2 : a + 1 + 1 + (b - (a + 1)) = b + 1,
                  {clear Hb Ha, -- because omega peculiarly does not work otherwise
                  omega}, -- Lean can solve this by itself
              rw p2,
              clear p2,
              simp,
              },

    },

    -- else-case (named ite1) : ¬ (nat.succ a < b + 1)
    { rw nat.succ_eq_add_one at *,
      repeat {rw remove_nth_eq_take_append_drop},
      /- goal is now in form :
         take b (take (a + 1) L ++ drop (a + 1 + 1) L)
         ++ drop (b + 1) (take (a + 1) L ++ drop (a + 1 + 1) L) =
         take (a + 1 - 1) (take b L ++ drop (b + 1) L)
         ++ drop (a + 1 - 1 + 1) (take b L ++ drop (b + 1) L)

         Again, we need to simplify this-/
      rw take_append, /- take b (take (a + 1) L ++ drop (a + 1 + 1) L) =
                         if (b ≤ length (take (a + 1) L)) then (take b (take (a + 1) L))
                         else (take (a + 1) L ++ take (b - length (take (a + 1) L)) (drop (a + 1 + 1) L))-/
      split_ifs with ite5,
        swap,
        -- else-case (named ite5) : ¬ (b ≤ length (take (a + 1) L))
        {exfalso, -- contradicts ite1 (rewrite ite5 until Lean finds the contradiction with linarith)
        push_neg at ite5,
        rw length_take at ite5,
        rw min_eq_left Ha at ite5,
        linarith},

        -- if-case (named ite5) : b ≤ length (take (a + 1) L)
        {rw drop_append, /- drop (b + 1) (take (a + 1) L ++ drop (a + 1 + 1) L) =
                            if (b + 1 ≤ length (take (a + 1) L)) then (drop (b + 1) (take (a + 1) L) ++ drop (a + 1 + 1) L)
                            else (drop (b + 1 - length (take (a + 1) L)) (drop (a + 1 + 1) L)-/
        push_neg at ite1, -- put ite5 in form b + 1 ≤ a + 1
        -- simplify if-condition
        rw length_take, -- length (take (a + 1) L) = min (a + 1) (length L)
        rw min_eq_left Ha, -- min (a + 1) (length L) = a + 1 because of Ha
        rw if_pos ite1, -- if-condition is exactly ite1, so is true
        rw drop_append, /- drop (a + 1 - 1 + 1) (take b L ++ drop (b + 1) L) =
                           if (a + 1 - 1 + 1 ≤ length (take b L))
                           then (drop (a + 1 - 1 + 1) (take b L) ++ drop (b + 1) L)
                           else (drop (a + 1 - 1 + 1 - length (take b L)) (drop (b + 1) L))-/
        split_ifs with ite6,

          -- if-case (named ite6) : a + 1 - 1 + 1 ≤ length (take b L)
          rw length_take at ite6, -- length (take b L) = min b (length L)
          rw min_eq_left (le_trans (nat.le_succ b) Hb) at ite6, -- min b (length L) = b (because of Hb and transitivity of ≤)
            {exfalso, -- ite6 contradicts ite1
            clear Ha Hb ite5,
            omega},

          -- else-case (named ite6) : ¬ (a + 1 - 1 + 1 ≤ length (take b L))
          rw take_append, /- take (a + 1 - 1) (take b L ++ drop (b + 1) L) =
                             if (a + 1 - 1 ≤ length (take b L))
                             then (take (a + 1 - 1) (take b L))
                             else (take b L ++ take (a + 1 - 1 - length (take b L))
                             (drop (b + 1) L))-/
              -- simplify if-condition to a + 1 - 1 ≤ b
          rw length_take,
          rw min_eq_left (le_trans (nat.le_succ b) Hb),

          split_ifs with ite7,

            -- if-case (named ite7) : a + 1 - 1 ≤ b
            {push_neg at ite6, -- put ite6 in form length (take b L) ≤ a + 1 - 1
            have eq: a + 1 - 1 = b,
              {rw length_take at ite6,
              rw min_eq_left (le_trans (nat.le_succ b) Hb) at ite6,
              exact le_antisymm ite7 ite6}, -- ite6 is now b ≤ a + 1 - 1, so with ite7 we have equality
            rw nat.add_sub_cancel at eq, -- get rid of 1 - 1 in eq
            rw eq, -- express everything in terms of b and L
            rw nat.add_sub_cancel, -- get rid of 1 - 1

            /- goal is now :
               take b (take (b + 1) L) ++ (drop (b + 1) (take (b + 1) L)
               ++ drop (b + 1 + 1) L) =
               take b (take b L) ++ drop (b + 1 - b) (drop (b + 1) L)-/

            rw take_take, --take b (take (b + 1) L) = take (min b (b + 1) L)
            rw min_eq_left (nat.le_succ b), -- min b (b + 1) = b (as b ≤ b + 1)
            rw drop_drop, -- drop (b + 1 - b) (drop (b + 1) L) = drop (b + 1 - b + (b + 1)) L
            rw take_take, -- take b (take b L) = take (min b b) L
            clear eq,
            rw min_eq_left (nat.le_refl b), -- min b b, because of reflexivity of ≤
            simp only [add_zero, nat.add_sub_cancel_left, add_comm, le_add_iff_nonneg_right],
            rw append_left_inj (take b L), /- take b L ++ (drop (b + 1) (take (b + 1) L) ++ drop (1 + (b + 1)) L) =
                                              take b L ++ drop (1 + (b + 1)) L
                                              ↔
                                              (drop (b + 1) (take (b + 1) L) ++ drop (1 + (b + 1)) L) =
                                              drop (1 + (b + 1)) L-/
            rw drop_take (b + 1) 0 L, -- drop (b + 1) (take (b + 1) L) = take 0 (drop (b + 1) L)
            rw take_zero, --take 0 (drop (b + 1) L) = nil
            rw nil_append,},

            -- else-case (named ite7) : ¬ (a + 1 - 1 ≤ b)
            /- goal is :
               take b (take (a + 1) L) ++ (drop (b + 1) (take (a + 1) L)
               ++ drop (a + 1 + 1) L) =
               take b L ++ take (a + 1 - 1 - b) (drop (b + 1) L)
               ++ drop (a + 1 - 1 + 1 - b) (drop (b + 1) L)-/

            {clear ite6,
            rw take_take, -- take b (take (a + 1) L) = take (min b (a + 1)) L
            rw drop_drop, -- drop (a + 1 - 1 + 1 - b) (drop (b + 1) L) = drop (a + 1 - 1 + 1 - b + (b + 1)) L
            rw length_take at ite5, -- so ite 5 is :  b ≤ min (a + 1) (length L)
            rw min_eq_left Ha at *, -- min (a + 1) (length L) = a + 1 , because of Ha  (everywhere)
            rw min_eq_left ite5 at *, -- min b (a + 1) = b , because of ite5  (everywhere)
            rw ← drop_take, -- take (a + 1 - 1 - b) (drop (b + 1) L) = drop (b + 1) (take (b + 1 + (a + 1 - 1 - b)) L)

            /- so goal is :
                take b L ++ (drop (b + 1) (take (a + 1) L) ++ drop (a + 1 + 1) L) =
                take b L ++ drop (b + 1) (take (b + 1 + (a + 1 - 1 - b)) L)
                ++ drop (a + 1 - 1 + 1 - b + (b + 1)) L

            and both sides are the same after simpifying the arithmetic-/
            have p1 : b + 1 + (a + 1 - 1 - b) = a + 1,
              clear Hb Ha,
              omega,
            rw p1,
            clear p1,
            have p2 : a + 1 - 1 + 1 - b + (b + 1) = a + 1 + 1,
              clear Hb Ha,
              omega,
            rw p2,
            clear p2,
            simp}, -- basically would just need associativity of append
    },
  },
end

/-- If two lists each with their nth element removed are the same,
    then their lengths are the same-/
lemma remove_nth_eq_remove_nth_to_length_eq {α : Type*} {A B : list α}:
∀ (n : ℕ) (hA : n < length A)(hB : n < length B), remove_nth A n = remove_nth B n
→ length A = length B:=
begin
intros n hA hB h,
-- show the length of the shortened lists are the same
have p : length (remove_nth A n) = length (remove_nth B n),
  {rw h},
-- show from that length A - 1 = length B - 1
rw length_remove_nth A n hA at p,
rw length_remove_nth B n hB at p,
/- as length A is a natural number, length A - 1 = 0 if length A = 0 in Lean,
   so we need the following, which follow from hA and hB
   (the leangths are strictly greater than some natural number, so at least 1)-/
have pa : 1 ≤ length A := by exact nat.one_le_of_lt hA,
have pb : 1 ≤ length B := by exact nat.one_le_of_lt hB,
exact nat.pred_inj pa pb p, -- now through pa and pb and p the result follows
end

/- drop -/

/-- If the index of the removed element is less than the amount b one wants to drop from the start,
    it is the same as dropping b + 1-/
lemma drop_remove_nth_le {a b : ℕ } {L : list ℤ} (h1 : a ≤ b) (h2 : b ≤ length L):
drop b (remove_nth L a) = drop (b + 1) L :=
begin
rw remove_nth_eq_take_append_drop,-- remove_nth L a = take a L ++ drop (a + 1) L
  rw drop_append, /- drop b (take a L ++ drop (a + 1) L) =
                     if (b ≤ length (take a L)),
                     then (drop b (take a L) ++ drop (a + 1) L),
                     else (drop (b - length (take a L)) (drop (a + 1) L))-/
  rw length_take, -- length (take a L) = min a (length L)
  rw min_eq_left (le_trans h1 h2), -- min a (length L) = a, because of h1 and h2
  split_ifs with ite,
    -- if-case (named ite) :  b ≤ a (in this case because of h1, a = b)
    {
    {have p1: a=b:= by exact le_antisymm h1 ite,
    rw p1,
    -- the statement then holds because drop b (take b L) = nil (we drop all we take)
    have p2 : drop b (take b L) = nil,
      {convert drop_all _,
      rw length_take,
      rw min_eq_left h2,},
    rw p2,
    rw nil_append}, -- nil ++ drop (b + 1) L = drop (b + 1) L
    },

    -- else-case (named ite) :  ¬ (b ≤ a)
    {rw drop_drop, -- drop (b - a) (drop (a + 1) L) = drop (b - a + (a + 1)) L
     congr' 1, /- instead of drop (b - a + (a + 1)) L = drop (b + 1) L
                  we can prove b - a + (a + 1) = b + 1 -/
     show b - a + a + 1 = b + 1,
     rw nat.sub_add_cancel h1,
    },
end

/--If dropping the first x elements of two lists gives the same list,
   so does dropping the first x + 1-/
lemma drop_aux_1 {A B : list ℤ} {x: ℕ } :
drop x A = drop x B → drop (nat.succ x) A = drop (nat.succ x) B :=
begin
intro H,
rw nat.succ_eq_add_one,
rw add_comm,
rw drop_add, -- lemma says : for all a, b in ℕ, lists L, drop (a + b) L = drop a (drop b L)
rw H,
rw drop_drop, -- drop_add backwards
end

/--If dropping the first x elements of two lists gives the same list,
so does dropping the first y if y ≥ x-/
lemma drop_aux_2 {A B : list ℤ} {x y : ℕ } (h : x ≤ y):
drop x A = drop x B → drop y A = drop y B :=
begin
/- The plan is to use induction on the difference n between x and y,
   then if n = 0 this is trivial and the inductive step is done using drop_aux_1-/
have P : ∃ (n:ℕ), y = x + n,
  {exact le_iff_exists_add.mp h},
cases P with n Pn, -- let n be s.t. (Pn : y = x + n)  holds
have Py : x = y - n,
  {rw Pn,
   rw nat.add_sub_cancel}, -- n and -n cancel
rw Py,
revert A B x y, -- do not want inductive hypothesis to depend on A,B,x,y
induction n with d hd,
    -- base case : n = 0
    {repeat {rw nat.add_zero}, -- x + 0 = x
    simp}, -- Lean can do this much by itself

    -- inductive step : n = nat.succ d
    {intros A B x y P Py Px H, -- A B x y P Py Px as before
    rw nat.succ_eq_add_one at Py,
    rw Py,
    rw ← add_assoc, -- associativity of +
    -- goal is now : drop (x + d + 1) A = drop (x + d + 1) B
    rw drop_add,  -- lemma says : for all a, b in ℕ, lists L, drop (a + b) L = drop a (drop b L)
    rw drop_add (x+d) 1 B,
    /- now the goal is drop (x + d) (drop 1 A) = drop (x + d) (drop 1 B)
       that is why we had to revert A and B
       this is the correct form for the inductive hypothesis
       with x = x , y = x + d, A = drop 1 A, B = drop 1 B
       but before we can use it we need a few trivial necessary hypotheses for
       hd-/
    rw ← Px at H,
    have triv1 : x ≤ x + d, simp,
    have triv2 : x + d = x + d, refl,
    have triv3 : x = x + d - d, simp,
    have H_new : drop (nat.succ x) A = drop (nat.succ x) B,
       {exact drop_aux_1 H},
    -- need H_new in the form : drop (x + d - d) (drop 1 A) = drop (x + d - d) (drop 1 B)
    rw nat.succ_eq_add_one at H_new,
    rw drop_add at H_new,
    rw drop_add x 1 B at H_new,
    rw triv3 at H_new,

    exact hd triv1 triv2 triv3 H_new}, -- use inductive hypothesis

end

/- take -/

/--If the first x+1 elements of two lists are the same, so are the first x-/
lemma take_aux_1 {A B : list ℤ} {x: ℕ } :
take (nat.succ x) A = take (nat.succ x) B → take x A = take x B :=
begin
revert B x, -- so inductive hypothesis does not depend on x or B
induction A with a An IH,

  -- base case : A =  nil
  {intros B x,
  cases B with b Bn, -- because we get a contradiction when B is non-empty

    -- B = nil
    { intro H,
      refl}, -- clearly take x nil = take x nil

    -- B = (b :: Bn)
    {intro H,
    exfalso, /- contradicts H : take (nat.succ x) nil = take (nat.succ x) (b :: Bn)
                as RHS is not nil -/
    rw take_nil at H, -- take (nat.succ x) nil
    rw take_cons at H, -- take (nat.succ x) (b :: Bn) = b :: take x Bn
    simp at H, -- Lean sees that H is false by itself
    exact H}},

  -- inductive step : A = (a :: An)
  {intros B x,
  cases B with b Bn, -- because we get a contradiction when B is empty

    -- B = nil  (similar to A = nil and B = (b :: Bn))
    {intro H,
    exfalso,
    rw take_nil at H,
    rw take_cons at H,
    simp at H,
    exact H},

    -- B = (b :: Bn)
    /- goal is now : take (nat.succ x) (a :: An) = take (nat.succ x) (b :: Bn)
                     → take x (a :: An) = take x (b :: Bn)-/
    cases x with y, /- we want to have some successor nat.succ y in place of x
                      because we want to use the inductive hypothesis with Bn and y
                      So we need to do the trivial x=0-case separately-/

      -- x = 0
      {intro H,
      rw take_zero, -- lemma says : take 0 L = nil , for any list L
      rw take_zero},

      -- x = nat.succ y
      {intro H,
      rw take_cons, /- Lemma says : for any list l, m of the correct type, n in ℕ,  \
                                    take (nat.succ n) (m :: l) = m :: take n l-/
      rw take_cons,
      rw take_cons at H,
      rw take_cons at H,

      /- now from H we need to extract the information that a = b (or
         equivalently [a] = [b]), and that
         take (nat.succ y) An = take (nat.succ y) Bn. The second one we
         need for the inductive hypothesis-/

      rw cons_eq_sing_append at H, -- see list.lemmas.simple
      rw cons_eq_sing_append b at H,

      have H_left : [a] = [b] ,
        {rw append_inj_right H _, /- if length [a] = length [b] then [a] = [b]
                                     (because by H, [a] ++ take (nat.succ y) An = [b] ++ take (nat.succ y) Bn-/
        simp},
      have H_right : take (nat.succ y) An = take (nat.succ y) Bn,
        {rw append_inj_left H _,  -- same as above, but equality of the right side of the append
         rw H_left},

      rw cons_eq_sing_append,
      rw cons_eq_sing_append b,
      rw H_left,
      rw append_left_inj [b], -- [b] ++ take y An = [b] ++ take y Bn ↔ take y An = take y Bn
      exact IH H_right},}, -- use inductive hypothesis
end

/--If the first x elements of two lists are the same, so are the first y if y ≤ x-/
lemma take_aux_2 {A B : list ℤ} {x y : ℕ } (h : y ≤  x):
take x A = take x B → take y A = take y B :=
begin
/- The plan is to use induction on the difference n between x and y,
   then if n = 0 this is trivial and the inductive step is done using take_aux_1-/
have P : ∃ (n:ℕ), x = y + n,
  {exact le_iff_exists_add.mp h},
cases P with n Pn, -- let n be s.t. (Pn : y = x + n)  holds
have Py : y = x - n,
  {rw Pn,
  rw nat.add_sub_cancel},
rw Py,

revert A B x y, -- so inductive hypothesis does not depend on A B x y
induction n with d hd,

  -- base case : n = 0
  {repeat {rw nat.sub_zero},
  simp}, -- Lean can solve take x A = take x B → take x A = take x B

  -- inductive step : n = nat.succ d
  {intros A B x y P Px Py H,
   rw ← Py,

  /- H is take x A = take x B, so if one of the lists is nil while the
     other is not, and x is non-zero, we get a contradiction,
     because only one side will be the empty list -/
  cases A with a An,

    -- A = nil
    {cases B with b Bn,

      -- B = nil
      {refl}, -- if both lists are nil, the result follows from def of take

      -- B = (b :: Bn)
      {cases y with y',

        -- y = 0
        /-(in this case x - nat.succ d = 0, so right side is take 0 (b :: Bn)
           which is also nil)-/
        {rw take_nil,
        rw take_zero},

        -- y = nat.succ y'
        {exfalso, -- y ≤ x, so x is positive
        rw take_nil at H,
        rw Px at H,
        rw take_cons at H,
        simp at H,
        exact H},},
    },

    -- A = (a :: An)
    {cases B with b Bn,

      -- B = nil  (similar to case where A = nil and B = (b :: Bn))
      {cases y with y',

        -- y = 0
        {rw take_nil,
        rw take_zero},

        -- y = nat.succ y'
        {exfalso,
        rw take_nil at H,
        rw Px at H,
        rw take_cons at H,
        simp at H,
        exact H},},

      -- B = (b :: Bn)  (main case, where we will need hd)
      /- now the goal is take (x - nat.succ d) (a :: An) = take (x - nat.succ d) (b :: Bn)
       this is the correct form for the inductive hypothesis
       with x = nat.succ y' + d , y = nat.succ y', A = An, B = Bn, for some y'
       so we want y in the form nat.succ y' and hence need to do the (y = 0)-case
       separately again-/
      {cases y with y',

        -- y = 0 (here both sides are nil again)
        {rw take_zero,
        rw take_zero},

        -- y = nat.succ y'

        {rw take_cons,
        rw take_cons,
        /- now from H we need to extract the information that a = b (or
         equivalently [a] = [b]), and that
         take (nat.succ y' + d) An = take (nat.succ y' + d) Bn. The second one we
         need to get a necessary hypothesis for the inductive hypothesis
         through take_aux_1-/

        rw Px at H,
        rw take_cons at H,
        rw take_cons at H,
        rw cons_eq_sing_append at H,
        rw cons_eq_sing_append b at H,

        have H_left : [a] = [b] ,
          {rw append_inj_right H,
          simp},
        have H_right : take (nat.succ y' + d) An = take (nat.succ y' + d) Bn,
          {rw append_inj_left H,
          simp},

        -- similarly to the proof of take_aux_1, we get rid of a and b in the goal
        rw cons_eq_sing_append,
        rw cons_eq_sing_append b,
        rw H_left,
        rw append_left_inj [b],

        -- now we create all the trivial hypotheses needed for the induction
        have triv1 : y' ≤ y' + d, simp,
        have triv2 : y' + d = y' + d, refl,
        have triv3 : y' = y' + d - d, simp,
        have H_new : take (y' + d) An = take (y' + d) Bn, -- H_new can be derived from H
          {rw nat.succ_add at H_right,
          exact take_aux_1  H_right},

        rw triv3, -- put the goal in the exact form of the result of the inductive hypothesis
        exact hd triv1 triv2 triv3 H_new},},}, -- use inductive hypotheses
  }
end

/--If you take the first m+1 elements of a list, revert the order and take the head
of the resulting list, you get the same element as when you drop the first m-1 elements,
and take the head and then the tail. (You get the m-th element counting from 0)-/
lemma take_drop_head_eq {A:list ℤ} {m : ℕ} (h1: 1 ≤ m) (h2: m + 1 ≤ length A):
head (reverse (take (m+1) A)) = head (tail (drop (m-1) A)):=
-- proof in term mode
by rw [
       tail_drop, head_reverse_take h2, nat.succ_eq_add_one,
       nat.sub_add_cancel h1, head_drop
       ]
/-
begin
  rw tail_drop,
            -- tail (drop (m - 1) A) = drop (nat.succ (m - 1)) A
  rw head_reverse_take h2,
            -- head (reverse (take (m + 1) A)) = nth_le A m h2
  rw [nat.succ_eq_add_one, nat.sub_add_cancel h1],
            -- nat.succ (m - 1) = m , because 1 ≤ m
  rw head_drop,
            -- head (drop m A) = nth_le A m _
end
-/

/--If you take the first d+2 elements of a list, revert the order and take the head
of the resulting list, you get the same element as when you drop the first d elements,
and take the head and then the tail. (You get the (d+1)th element element counting from 0)-/
lemma take_drop_head_eq' {A:list ℤ} {d : ℕ} (h2: d + 2 ≤ length A):
head (reverse (take (d+2) A)) = head (tail (drop d A)):=
-- proof in term mode (proof similar to lemma above)
by rw [tail_drop, head_reverse_take h2, head_drop]

/- nth_le -/

/--the nth element of a list with an element removed is the bth or (b+1)th
element of the full list, depending on which element was removed-/
lemma nth_le_remove_nth {a b : ℕ } (L : list ℤ) (h:b < length (remove_nth L a)) (h1 h2):
nth_le (remove_nth L a) b h =
if a ≤ b then nth_le L (b+1) h1
else nth_le L b h2:=
begin
split_ifs with ite1,
  -- if-case (named ite1) : a ≤ b
  {rw ← head_drop, -- nth_le (remove_nth L a) b h = head (drop b (remove_nth L a))
  rw ← head_drop,  -- nth_le L (b + 1) h1 = head (drop (b + 1) L)
  apply head_eq_of_list_eq, -- if the lists are equal, their heads are equal
  rw drop_remove_nth_le ite1 (le_of_lt h2), -- now the goal is just the result this lemma (see line 396)
  },

  -- else-case (named ite1) : ¬ (a ≤ b)
  {{repeat {rw ← head_drop},-- goal becomes : head (drop b (remove_nth L a)) = head (drop b L)
  push_neg at ite1, -- puts ite1 in form b < a
  /- this time the lists we are taking the head of are not equal, as drop b (remove_nth L a)
      has one element less than drop b L-/
  rw remove_nth_eq_take_append_drop, -- remove_nth L a = drop b (take a L ++ drop (a + 1) L)
  rw drop_append, /- drop b (take a L ++ drop (a + 1) L) =
                     if (b ≤ length (take a L)),
                     then (drop b (take a L) ++ drop (a + 1) L),
                     else (drop (b - length (take a L)) (drop (a + 1) L))-/
  rw length_take,
  rw if_pos (le_min (le_of_lt ite1) (le_of_lt h2)), -- we have b ≤ length (take a L), because b < a by ite1 and b < length L by h2

  /- we want to use that head (drop b (take a L) ++ drop (a + 1) L)
     = head (drop b (take a L), because drop b (take a L) is not nil, as b < a and b < length L
     so we need to prove the following as well:-/
  have P : drop b (take a L) ≠ nil,
    {apply ne_nil_of_length_eq_succ , /- we prove this by proving length (drop b (take a L))
    is the successor of some natural number (so greater than 0),
    that natural number is (min a (length L) - b - 1)-/
      swap,
      {exact min a (length L) - b - 1},
    rw length_drop, -- length (drop b (take a L)) = length (take a L) - b
    rw length_take, -- length (take a L) = min a (length L)
    rw nat.succ_eq_add_one, --nat.succ (min a (length L) - b - 1) =  min a (length L) - b - 1 + 1
    rw nat.sub_add_cancel, /- min a (length L) - b - 1 + 1 = min a (length L) - b, as reqired,
                              if min a (length L) - b ≥ 1  (because 0 - 1 = 0 in ℕ )-/
    show 1 ≤ (min a (length L)) - b, -- use ≤ , because ≥ is defined via ≤
    apply nat.le_sub_right_of_add_le, -- 1 + b ≤ min a (length L) → 1 ≤ min a (length L) - b
    apply le_min, -- suffices to prove 1 + b ≤ a and 1 + b ≤ length L
    rw add_comm,
    exact ite1, -- first one is true by ite1 (b < a)
    rw add_comm,
    exact (le_of_lt h1),}, -- second one by h1 (b < length L)

  rw head_append _ P, -- now we can use that
  /- The goal is now : head (drop b (take a L)) = head (drop b L)

     we will put  head (drop b L) in the form head (drop b (take a L) ++ something)
     and then use head_append again-/
  rw ← take_append_drop a L, -- drop b L = drop b (take a L ++ drop a L)
  rw drop_append, /- drop b (take a L ++ drop a L) =
                     if (b ≤ length (take a L)),
                     then  (drop b (take a L) ++ drop a L),
                     else (drop (b - length (take a L)) (drop a L)))-/
  rw length_take,
  rw if_pos (le_min (le_of_lt ite1) (le_of_lt h2)), -- we have b ≤ length (take a L), because b < a by ite1 and b < length L by h2
  rw take_append_drop a L, -- revert the change of the LHS from line 797
  rw head_append _ P, -- head (drop b (take a L) ++ drop a L) = head (drop b (take a L)) by P

},},
end


/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import measure_theory.measurable_space

import measure_theory.measure_space
import measure_theory.outer_measure
import measure_theory.lebesgue_measure
import measure_theory.integration
import measure_theory.borel_space
import formal_ml.set
import formal_ml.measurable_space
import formal_ml.topological_space

/-
  The big question is how to introduce a measurable function over the reals.
  The topology over the reals is induced by a metric space, using absolute difference as a
  measure of distance. This metric space induces a topological_space.
  The measurable space is the borel space on top of this topological space.

  A key result is borel_eq_generate_from_of_subbasis. which shows that if a basis generates a
  second countable topology, it generates the borel space as well. For example, consider an
  arbitrary open sets on the real line. For any point x in the open set, there exists a real number
  e such that the open interval (x-e,x+e) is in the set. Moreover, there is a rational number p in
  the interval (x-e,x) and another in (x,x+e), implying x is in (p,q). If we take union of all the
  intervals (p,q) for each x in U, then we get U. So, the set of all open intervals with rational
  endpoints is a countable basis, implying the reals are a second order topology. It is also
  immediately obvious that any open set can be formed with a countable union for the reals.

  However, let's look at an arbitrary second countable topology. The generalization of Lindelöf's
  lemma shows that for a second countable topology, there is a set of open sets such that any open
  set is the countable union. For Munkres, the definition of second countable topology is that
  there exists a countable basis. The definition of basis from Munkres is that for every point is
  contained in at least one basis set, and for any element x in the intersection of two basis sets A
  and B, there is a basis set C containing x that is a subset of B and C.
  set, and to generate the topology, one considers arbitrary union of elements in the bases. Thus,
  any union of a subset of a countable set must be representable as a countable union. So, there
  is a countable union.

  The more interesting part of borel_eq_generate_from_of_subbasis is that ANY set that generates
  a second countable topology is a basis for the borel space. I am not exactly sure how this
  works: regardless, the theorem gives great insights into second countable topologies
  (especially, reals, nnreals, ennreals, et cetera) and borel
  measures.

  To start with, this implies that the cartesian product of the borel spaces is the same as the
  borel space of the cartesian product of the topologies (i.e. it commutes). So, results about
  continuous functions on two real variables (e.g., add, multiply, power) translate to
  measurable functions on measurable spaces.
-/

/-
  We begin with basic guarantees about intervals and measurable functions.
 -/
set_option pp.implicit true

lemma nnreal_measurable_space_def:nnreal.measurable_space = borel nnreal := rfl
lemma real_measurable_space_def:real.measurable_space = borel real := rfl
lemma ennreal_measurable_space_def:ennreal.measurable_space = borel ennreal := rfl

lemma borel_eq_generate_Iic (α:Type*)
  [topological_space α] [topological_space.second_countable_topology α]
  [linear_order α] [order_topology α] :
  borel α = measurable_space.generate_from (set.range set.Iic) :=
begin
  rw borel_eq_generate_Ioi α,
  apply le_antisymm,
  {
    rw measurable_space.generate_from_le_iff,
    rw set.subset_def,
    intros V A1,
    simp,
    simp at A1,
    cases A1 with y A1,
    subst V,
    rw ← set.compl_Iic,
    apply measurable_space.generate_measurable.compl,
    apply measurable_space.generate_measurable.basic,
    simp,
  },
  {
    rw measurable_space.generate_from_le_iff,
    rw set.subset_def,
    intros V A1,
    simp,
    simp at A1,
    cases A1 with y A1,
    subst V,
    rw ← set.compl_Ioi,
    apply measurable_space.generate_measurable.compl,
    apply measurable_space.generate_measurable.basic,
    simp,
  },
end

lemma measurable_set_intro_Iio (α β: Type*) [M:measurable_space α] [_inst_1 : topological_space β]
  [_inst_2 : @topological_space.second_countable_topology β _inst_1] [_inst_3 : linear_order β]
  [_inst_4 : @order_topology β _inst_1 (@partial_order.to_preorder β (@linear_order.to_partial_order β _inst_3))]
  (f:α → β):(∀ b:β, measurable_set (set.preimage f {y|y < b})) →
            (@measurable α β M  (borel β) f) :=
begin
  intros A1,
  rw borel_eq_generate_Iio β,
  apply generate_from_measurable,
  refl,
  intros,
  cases H with z A2,
  subst B,
  unfold set.Iio,
  apply A1,
end

lemma is_nnreal_measurable_intro_Iio {α:Type*}
  [M:measurable_space α] (f:α → nnreal):
  (∀ x:nnreal, measurable_set (set.preimage f {y|y < x})) →
  (measurable f) :=
begin
  rw nnreal_measurable_space_def,
  apply measurable_set_intro_Iio,
end

lemma is_ennreal_measurable_intro_Iio {α:Type*}
  [M:measurable_space α] (f:α → ennreal):
  (∀ x:ennreal, measurable_set (set.preimage f {y|y < x})) →
  (measurable f) :=
begin
  rw ennreal_measurable_space_def,
  apply measurable_set_intro_Iio,
end

lemma is_real_measurable_intro_Iio {α:Type*}
  [M:measurable_space α] (f:α → real):
  (∀ x:real, measurable_set (set.preimage f {y|y < x})) →
  (measurable f) :=
begin
  rw real_measurable_space_def,
  apply measurable_set_intro_Iio,
end

lemma measurable_set_set_intro_Iio (β: Type*) [_inst_1 : topological_space β]
  [_inst_2 : @topological_space.second_countable_topology β _inst_1] [_inst_3 : linear_order β]
  [_inst_4 : @order_topology β _inst_1 (@partial_order.to_preorder β (@linear_order.to_partial_order β _inst_3))]
  (b:β):@measurable_set β (borel β) {y|y < b} :=
begin
  rw (@borel_eq_generate_Iio β _ _ _ _),
  apply measurable_space.measurable_set_generate_from,
  simp,
  unfold set.Iio,
  apply exists.intro b,
  refl,
end

lemma is_nnreal_measurable_set_intro_Iio (x:nnreal):
  (measurable_set {y|y < x}) :=
begin
  rw nnreal_measurable_space_def,
  apply measurable_set_set_intro_Iio,
end

lemma is_ennreal_measurable_set_intro_Iio (x:ennreal):
  (measurable_set {y|y < x}) :=
begin
  rw ennreal_measurable_space_def,
  apply measurable_set_set_intro_Iio,
end

lemma is_real_measurable_set_intro_Iio (x:real):
  (measurable_set {y|y < x}) :=
begin
  rw real_measurable_space_def,
  apply measurable_set_set_intro_Iio,
end

lemma measurable_set_set_intro_Ioi (β: Type*) [_inst_1 : topological_space β]
  [_inst_2 : @topological_space.second_countable_topology β _inst_1] [_inst_3 : linear_order β]
  [_inst_4 : @order_topology β _inst_1 (@partial_order.to_preorder β (@linear_order.to_partial_order β _inst_3))]
  (b:β):@measurable_set β (borel β) {y|b < y} :=
begin
  rw (@borel_eq_generate_Ioi β _ _ _ _),
  apply measurable_space.measurable_set_generate_from,
  simp,
  unfold set.Ioi,
  apply exists.intro b,
  refl,
end

lemma is_nnreal_measurable_set_intro_Ioi (x:nnreal):
  (measurable_set {y|x < y}) :=
begin
  rw nnreal_measurable_space_def,
  apply measurable_set_set_intro_Ioi,
end

lemma is_ennreal_measurable_set_intro_Ioi (x:ennreal):
  (measurable_set {y|x < y}) :=
begin
  rw ennreal_measurable_space_def,
  apply measurable_set_set_intro_Ioi,
end

lemma is_real_measurable_set_intro_Ioi (x:real):
  (measurable_set {y|x < y}) :=
begin
  rw real_measurable_space_def,
  apply measurable_set_set_intro_Ioi,
end

lemma measurable_set_intro_Ioi (α β: Type*) [M:measurable_space α] [_inst_1 : topological_space β]
  [_inst_2 : @topological_space.second_countable_topology β _inst_1] [_inst_3 : linear_order β]
  [_inst_4 : @order_topology β _inst_1 (@partial_order.to_preorder β (@linear_order.to_partial_order β _inst_3))]
  (f:α → β):(∀ b:β, measurable_set (set.preimage f {y|b<  y})) →
            (@measurable α β M  (borel β) f) :=
begin
  intros A1,
  rw borel_eq_generate_Ioi β,
  apply generate_from_measurable,
  refl,
  intros,
  cases H with z A2,
  subst B,
  unfold set.Ioi,
  apply A1,
end

lemma is_nnreal_measurable_intro_Ioi {α:Type*}
  [M:measurable_space α] (f:α → nnreal):
  (∀ x:nnreal, measurable_set (set.preimage f {y|x < y})) →
  (measurable f) :=
begin
  rw nnreal_measurable_space_def,
  apply measurable_set_intro_Ioi,
end

lemma is_ennreal_measurable_intro_Ioi {α:Type*}
  [M:measurable_space α] (f:α → ennreal):
  (∀ x:ennreal, measurable_set (set.preimage f {y|x < y})) →
  (measurable f) :=
begin
  rw ennreal_measurable_space_def,
  apply measurable_set_intro_Ioi,
end

lemma is_real_measurable_intro_Ioi {α:Type*}
  [M:measurable_space α] (f:α → real):
  (∀ x:real, measurable_set (set.preimage f {y|x < y})) →
  (measurable f) :=
begin
  rw real_measurable_space_def,
  apply measurable_set_intro_Ioi,
end

lemma Iic_Iio_compl (β: Type*) [L : linear_order β] (x:β):{y:β|y ≤ x}ᶜ={y:β|x < y}  :=
begin
  intros,
  ext,split;intros A1,
  {
    simp,
    simp at A1,
    exact A1,
  },
  {
    simp,
    simp at A1,
    exact A1,
  }
end

lemma Ioi_Iic_compl (β: Type*) [L : linear_order β] (x:β):{y:β|x < y}={y:β|y ≤ x}ᶜ :=
begin
  intros,
  ext,split;intros A1,
  {
    simp,
    simp at A1,
    exact A1,
  },
  {
    simp,
    simp at A1,
    exact A1,
  }
end

lemma Ici_Iio_compl (β: Type*) [L : linear_order β] (x:β):{y:β|x ≤ y}={y:β|y < x}ᶜ :=
begin
  intros,
  ext,split;intros A1,
  {
    simp,
    simp at A1,
    exact A1,
  },
  {
    simp,
    simp at A1,
    exact A1,
  }
end

lemma Iic_Ioi_compl (β: Type*) [L : linear_order β] (x:β):{y:β|y ≤ x}={y:β|x < y}ᶜ :=
begin
  ext, split; intros A1; simp; simp at A1; exact A1,
end

lemma measurable_set_intro_Iic (α β: Type*) [M:measurable_space α] [_inst_1 : topological_space β]
  [_inst_2 : @topological_space.second_countable_topology β _inst_1] [_inst_3 : linear_order β]
  [_inst_4 : @order_topology β _inst_1 (@partial_order.to_preorder β (@linear_order.to_partial_order β _inst_3))]
  (f:α → β):(∀ b:β, measurable_set (set.preimage f {y|y ≤ b})) →
            (@measurable α β M  (borel β) f) :=
begin
  intros A1,
  apply measurable_set_intro_Ioi,
  intros x,
  rw ← Iic_Iio_compl,
  apply measurable_set.compl,
  apply A1,
end

lemma is_nnreal_measurable_intro_Iic {α:Type*}
  [M:measurable_space α] (f:α → nnreal):
  (∀ x:nnreal, measurable_set (set.preimage f {y|y ≤ x})) →
  (measurable f) :=
begin
  rw nnreal_measurable_space_def,
  apply measurable_set_intro_Iic,
end

lemma measurable_set_elim_Iio (α β: Type*) [M:measurable_space α] [_inst_1 : topological_space β]
  [_inst_2 : @topological_space.second_countable_topology β _inst_1] [_inst_3 : linear_order β]
  [_inst_4 : @order_topology β _inst_1 (@partial_order.to_preorder β (@linear_order.to_partial_order β _inst_3))]
  (f:α → β) (b:β):(@measurable α β M  (borel β) f) →
(measurable_set (set.preimage f {y|y < b})) :=
begin
  intros A1,
  apply @measurable_elim α β M (borel β),
  apply A1,
  rw borel_eq_generate_Iio β,
  apply measurable_space.measurable_set_generate_from,
  simp,
  apply exists.intro b,
  unfold set.Iio,
end

lemma is_nnreal_measurable_elim_Iio {α:Type*}
  [M:measurable_space α] (f:α → nnreal) (x:nnreal):
  (measurable f) →
  measurable_set (set.preimage f {y|y < x}) :=
begin
  rw nnreal_measurable_space_def,
  apply measurable_set_elim_Iio,
end

lemma measurable_set_set_intro_Ici (β: Type*) [_inst_1 : topological_space β]
  [_inst_2 : @topological_space.second_countable_topology β _inst_1] [_inst_3 : linear_order β]
  [_inst_4 : @order_topology β _inst_1 (@partial_order.to_preorder β (@linear_order.to_partial_order β _inst_3))]
  (b:β):@measurable_set β (borel β) {y|b ≤ y} :=
begin
  rw Ici_Iio_compl,
  apply measurable_set.compl,
  apply measurable_set_set_intro_Iio,
end

lemma is_nnreal_measurable_set_intro_Ici
  (b:nnreal):measurable_set {y|b ≤ y} :=
begin
  apply measurable_set_set_intro_Ici,
end

--#check set.Iic_eq_compl_Ioi

lemma measurable_set_set_intro_Iic (β: Type*) [_inst_1 : topological_space β]
  [_inst_2 : @topological_space.second_countable_topology β _inst_1] [_inst_3 : linear_order β]
  [_inst_4 : @order_topology β _inst_1 (@partial_order.to_preorder β (@linear_order.to_partial_order β _inst_3))]
  (b:β):@measurable_set β (borel β) {y|y ≤ b} :=
begin
  rw Iic_Ioi_compl,
  apply measurable_set.compl,
  apply measurable_set_set_intro_Ioi,
end

lemma is_nnreal_measurable_set_intro_Iic
  (b:nnreal):measurable_set {y|b ≤ y} :=
begin
  apply measurable_set_set_intro_Ici,
end

lemma is_ennreal_measurable_set_intro_Iic
  (b:ennreal):measurable_set {y|b ≤ y} :=
begin
  apply measurable_set_set_intro_Ici,
end

lemma measurable_set_elim_Iic (α β: Type*) [M:measurable_space α] [_inst_1 : topological_space β]
  [_inst_2 : @topological_space.second_countable_topology β _inst_1] [_inst_3 : linear_order β]
  [_inst_4 : @order_topology β _inst_1 (@partial_order.to_preorder β (@linear_order.to_partial_order β _inst_3))]
  (f:α → β) (b:β):(@measurable α β M  (borel β) f) →
(measurable_set (set.preimage f {y|y ≤ b})) :=
begin
  intro A1,
  apply @measurable_elim α β M (borel β),
  apply A1,
  rw borel_eq_generate_Ioi β,
  have A2:{y|y ≤ b}={y|b<y}ᶜ,
  {
     ext,split; intro A2A,
     {
       simp,
       simp at A2A,
       exact A2A,
     },
     {
       simp,
       simp at A2A,
       exact A2A,
     }
  },
  rw A2,
  apply measurable_set.compl,
  apply measurable_space.measurable_set_generate_from,
  simp,
  apply exists.intro b,
  refl,
end

lemma is_nnreal_measurable_elim_Iic {α:Type*}
  [M:measurable_space α] (f:α → nnreal) (x:nnreal):
  (measurable f) →
  (measurable_set (set.preimage f {y|y ≤ x})) :=
begin
  rw nnreal_measurable_space_def,
  apply measurable_set_elim_Iic,
end

lemma is_real_measurable_elim_Iic {α:Type*}
  [M:measurable_space α] (f:α → real) (x:real):
  (measurable f) →
  (measurable_set (set.preimage f {y|y ≤ x})) :=
begin
  rw real_measurable_space_def,
  apply measurable_set_elim_Iic,
end

/-
  Many more elimination rules can be added here.
  -/

lemma borel_def {α:Type*} [topological_space α]:(borel α) =
  measurable_space.generate_from {s : set α | is_open s} := rfl

lemma continuous_measurable {α β:Type*} [topological_space α] [topological_space β] (f:α → β):
continuous f →
@measurable α β (borel α) (borel β) f :=
begin
  intros A1,
  rw borel_def,
  rw borel_def,
  apply generate_from_measurable,
  {
    refl,
  },
  {
    intros,
    apply measurable_space.measurable_set_generate_from,
    rw continuous_def at A1,
    apply A1,
    apply H,
  }
end

lemma borel_def_prod_second_countable {α β:Type*} [Tα:topological_space α]
  [Tβ:topological_space β]
  [SCα:topological_space.second_countable_topology α]
  [SCβ:topological_space.second_countable_topology β]
  :(@prod.measurable_space α β (borel α) (borel β)) =
   (@borel (α × β) (@prod.topological_space α β Tα Tβ)) :=
begin
  /- Note that the second countable property is required here. For instance the topology with
     a basis [x,y) is not second countable, and its product has a set that is open, but not
     coverable with a countable number of sets (e.g., the line y = -x). So, this would not work.

     The general idea is that since each topology has a countable basis the product topology
     has a countable basis as well.
    -/
  have A1:∃b:set (set α), set.countable b ∧ Tα = topological_space.generate_from b,
  {
    apply SCα.is_open_generated_countable,
  },
  cases A1 with basisα A1,
  cases A1 with A2 A3,
  rw (@borel_eq_generate_from_of_subbasis α basisα _ _ A3),
  have A4:∃b:set (set β), set.countable b ∧ Tβ = topological_space.generate_from b,
  {
    apply SCβ.is_open_generated_countable,
  },
  cases A4 with basisβ  A4,
  cases A4 with A5 A6,
  rw (@borel_eq_generate_from_of_subbasis β basisβ _ _ A6),
  rw prod_measurable_space_def,
  rw @borel_eq_generate_from_of_subbasis,
  rw A3,
  rw A6,
  rw prod_topological_space_def,
end

lemma continuous_measurable_binary {α β γ:Type*} [topological_space α] [topological_space β]
    [topological_space γ]
    [topological_space.second_countable_topology α]
    [topological_space.second_countable_topology β]
    (f:α × β → γ):
  continuous f → (@measurable (α × β) γ (@prod.measurable_space α β (borel α) (borel β)) (borel γ) f) :=
begin
  rw borel_def_prod_second_countable,
  apply continuous_measurable,
end

-- Note: there used to be theorems like this in mathlib, but they disappeared
lemma measurable_set_of_is_open {α:Type*} [topological_space α]
    (S:set α):is_open S → measurable_space.measurable_set' (borel α) S :=
begin
  rw borel_def,
  apply measurable_space.measurable_set_generate_from,
end

lemma measurable_set_of_is_closed {α:Type*} [topological_space α]
    (S:set α):is_closed S → measurable_space.measurable_set' (borel α) S :=
begin
  intro A1,
  unfold is_closed at A1,
  have A2:S = ((Sᶜ)ᶜ),
  {
    rw compl_compl,
  },
  rw A2,
  apply measurable_space.measurable_set_compl,
  apply measurable_set_of_is_open,
  apply A1,
end

lemma is_open_measurable_set_binary {α β:Type*} [topological_space α] [topological_space β]
    [topological_space.second_countable_topology α]
    [topological_space.second_countable_topology β]
    (S:set (α × β)):is_open S → measurable_space.measurable_set' (@prod.measurable_space α β (borel α) (borel β)) S :=
begin
  rw borel_def_prod_second_countable,
  apply measurable_set_of_is_open,
end

lemma is_closed_measurable_set_binary {α β:Type*} [topological_space α] [topological_space β]
    [topological_space.second_countable_topology α]
    [topological_space.second_countable_topology β]
    (S:set (α × β)):is_closed S → measurable_space.measurable_set' (@prod.measurable_space α β (borel α) (borel β)) S :=
begin
  rw borel_def_prod_second_countable,
  apply measurable_set_of_is_closed,
end

lemma SC_composition {Ω:Type*} [MΩ:measurable_space Ω]
  {β:Type*} [Tβ:topological_space β] [CT:topological_space.second_countable_topology β]
  (f:Ω → β) (g:Ω → β) (h:β  → β → β):
  (@measurable Ω β MΩ (borel β) f) →
  (@measurable Ω β MΩ (borel β) g) →
  continuous2 h →
  @measurable Ω β MΩ (borel β) (λ ω:Ω, h (f ω) (g ω)) :=
begin
  intros A1 A2 A3,
  have A4:@measurable Ω (β × β) MΩ (@prod.measurable_space β β (borel β) (borel β)) (λ ω:Ω, prod.mk (f ω) (g ω)),
  {
    apply measurable_fun_product_measurable;assumption,
  },
  have A5:@measurable (β × β) β (@prod.measurable_space β β (borel β) (borel β)) (borel β) (λ p: (β × β), h (p.fst) (p.snd)),
  {
    rw continuous2_def at A3,
    apply continuous_measurable_binary,
    apply A3,
  },
  have A6:(λ ω:Ω, h (f ω) (g ω))=(λ p: (β × β), h (p.fst) (p.snd)) ∘ (λ ω:Ω, prod.mk (f ω) (g ω)),
  {
    simp,
  },
  rw A6,
  apply @compose_measurable_fun_measurable Ω (β × β)  β  MΩ (@prod.measurable_space β β (borel β) (borel β)) (borel β)  (λ p: (β × β), h (p.fst) (p.snd)) (λ ω:Ω, prod.mk (f ω) (g ω)) A5 A4,
end

lemma nnreal_composition {Ω:Type*} [MΩ:measurable_space Ω]
  (f:Ω → nnreal) (g:Ω → nnreal) (h:nnreal → nnreal → nnreal):
  measurable f →
  measurable g →
  continuous2 h →
  measurable (λ ω:Ω, h (f ω) (g ω)) :=
begin
  apply SC_composition,
end

lemma SC_sum_measurable {Ω:Type*} [MΩ:measurable_space Ω]
  {β:Type*} {T:topological_space β} {SC:topological_space.second_countable_topology β}
   {CSR:add_monoid β} {TA:has_continuous_add β}
  (X Y:Ω → β):
  (@measurable _ _ _ (borel β) X) →
  (@measurable _ _ _ (borel β) Y) →
  (@measurable _ _ _ (borel β) (λ ω:Ω, (X ω + Y ω))) :=
begin
  intros A1 A2,
  apply @SC_composition Ω MΩ β T SC X Y,
  apply A1,
  apply A2,
  apply TA.continuous_add,
end

lemma SC_neg_measurable {Ω:Type*} [MΩ:measurable_space Ω]
  {β:Type*} {T:topological_space β} {SC:topological_space.second_countable_topology β}
   {CSR:add_group β} {TA:topological_add_group β}
  (X:Ω → β):
  (@measurable _ _ _ (borel β) X) →
  (@measurable _ _ _ (borel β) (λ ω:Ω, (-X ω))) :=
begin
  intros A1,
  have A2:(λ (ω:Ω), -X ω)=has_neg.neg ∘ X := rfl,
  rw A2,
  apply @compose_measurable_fun_measurable Ω β β MΩ (borel β) (borel β),
  {
    apply continuous_measurable,
    apply topological_add_group.continuous_neg,
  },
  {
    apply A1,
  },
end

--const_measurable {Ω:Type*} [measurable_space Ω] {β:Type*} [measurable_space β] (c:β)
/-
∀ {α : Type u_1} {β : Type u_2} [_inst_1 : measurable_space α] [_inst_2 : measurable_space β] {a : α},
    @measurable β α _inst_2 _inst_1 (λ (b : β), a)
-/

def SC_sum_measurable_is_add_submonoid
{Ω:Type*} [MΩ:measurable_space Ω]
  {β:Type*} {T:topological_space β} {SC:topological_space.second_countable_topology β}
   {CSR:add_monoid β} {TA:has_continuous_add β}:
  is_add_submonoid (@measurable Ω β MΩ (borel β)) := {
    zero_mem := @measurable_const β Ω (borel β) MΩ (0:β),
    add_mem := @SC_sum_measurable Ω MΩ β T SC CSR TA,
  }

def SC_sum_measurable_is_add_subgroup
{Ω:Type*} [MΩ:measurable_space Ω]
  {β:Type*} {T:topological_space β} {SC:topological_space.second_countable_topology β}
   {CSR:add_group β} {TA:topological_add_group β}:
  is_add_subgroup (@measurable Ω β MΩ (borel β)) := {
    zero_mem := @measurable_const β Ω (borel β) MΩ (0:β),
    add_mem := @SC_sum_measurable Ω MΩ β T SC (add_group.to_add_monoid β)
               (topological_add_group.to_has_continuous_add),
    neg_mem := @SC_neg_measurable Ω MΩ β T SC CSR TA,
  }

lemma SC_mul_measurable {Ω:Type*} [MΩ:measurable_space Ω]
  {β:Type*} {T:topological_space β} {SC:topological_space.second_countable_topology β}
   {CSR:monoid β} {TA:has_continuous_mul β}
  (X Y:Ω → β):
  (@measurable _ _ _ (borel β) X) → (@measurable _ _ _ (borel β) Y) →
  (@measurable _ _ _ (borel β) (λ ω:Ω, (X ω * Y ω))) :=
begin
  intros A1 A2,
  apply @SC_composition Ω MΩ β T SC X Y,
  apply A1,
  apply A2,
  apply TA.continuous_mul,
end

def SC_mul_measurable_is_submonoid
{Ω:Type*} [MΩ:measurable_space Ω]
  {β:Type*} {T:topological_space β} {SC:topological_space.second_countable_topology β}
   {CSR:monoid β} {TA:has_continuous_mul β}:
  is_submonoid (@measurable Ω β MΩ (borel β)) := {
    one_mem := @measurable_const β Ω (borel β) MΩ (1:β),
    mul_mem := @SC_mul_measurable Ω MΩ β T SC CSR TA,
  }

lemma nnreal_sum_measurable {Ω:Type*} [MΩ:measurable_space Ω] (X Y:Ω → nnreal):
  (measurable X) → (measurable Y) →
  measurable (λ ω:Ω, (X ω + Y ω)) :=
begin
  apply SC_sum_measurable,
  apply nnreal.topological_space.second_countable_topology,
  apply nnreal.topological_semiring.to_has_continuous_add,
end

lemma finset_sum_measurable {Ω β:Type*} [measurable_space Ω] [decidable_eq β]
  {γ:Type*} {T:topological_space γ} {SC:topological_space.second_countable_topology γ}
   {CSR:add_comm_monoid γ} {TA:has_continuous_add γ}
   (S:finset β) (X:β → Ω → γ):
  (∀ b:β, @measurable Ω  γ _  (borel γ) (X b)) →
  @measurable Ω γ _ (borel γ) (λ ω:Ω, S.sum (λ b:β, ((X b) ω))) :=
begin
  apply finset.induction_on S,
  {
    intros A1,
    simp,
  },
  {
    intros b T A2 A3 A4,
    -- A3,
    -- A4 B,
    have A5:(λ (ω : Ω), finset.sum (insert b T) (λ (b : β), X b ω)) =
    (λ (ω : Ω), (X b ω) + finset.sum T (λ (b : β), X b ω)),
    {
      ext,
      rw finset.sum_insert,
      exact A2,
    },
    rw A5,
    apply SC_sum_measurable,
    {
      apply SC,
    },
    {
      apply TA,
    },
    {
      apply A4,
    },
    {
      apply A3,
      exact A4,
    }
  }
end

lemma finset_sum_measurable_classical {Ω β:Type*} [MΩ:measurable_space Ω]
  {γ:Type*} {T:topological_space γ} {SC:topological_space.second_countable_topology γ}
   {CSR:add_comm_monoid γ} {TA:has_continuous_add γ}
   (S:finset β) (X:β → Ω → γ):
  (∀ b:β, @measurable  Ω γ _ (borel γ) (X b)) →
  @measurable Ω γ _ (borel γ) (λ ω:Ω, S.sum (λ b:β, ((X b) ω))) :=
begin
  have D:decidable_eq β,
  {
    apply classical.decidable_eq β,
  },
  apply @finset_sum_measurable Ω β MΩ D γ T SC CSR TA S X,
end

lemma nnreal_finset_sum_measurable {Ω β:Type*} [measurable_space Ω] [decidable_eq β] (S:finset β) (X:β → Ω → nnreal):
  (∀ b:β, measurable (X b)) →
  measurable (λ ω:Ω, S.sum (λ b:β, ((X b) ω))) :=
begin
  apply finset_sum_measurable,
  apply_instance,
  apply_instance,
end

lemma fintype_sum_measurable {Ω β:Type*} [F:fintype β] (X:β → Ω → nnreal) [M:measurable_space Ω]:
  (∀ b:β, measurable (X b)) →
  measurable (λ ω:Ω, F.elems.sum (λ b:β, ((X b) ω))) :=
begin
  have A1:decidable_eq β,
  {
    apply classical.decidable_eq,
  },
  apply @nnreal_finset_sum_measurable Ω β M A1,
end

lemma nnreal_fintype_sum_measurable {Ω β:Type*} [F:fintype β] (X:β → Ω → nnreal) [M:measurable_space Ω]:
  (∀ b:β, measurable (X b)) →
  measurable (λ ω:Ω, F.elems.sum (λ b:β, ((X b) ω))) :=
begin
  have A1:decidable_eq β,
  {
    apply classical.decidable_eq,
  },
  apply @nnreal_finset_sum_measurable Ω β M A1,
end

lemma nnreal_div_mul (x y:nnreal):(x/y = x * y⁻¹) :=
begin
  refl,
end

----------------Measurable Sets For Inequalities ---------------------------------------------------
-- These are basic results about order topologies.

lemma is_closed_le_alt {α:Type*} [T:topological_space α] [P:linear_order α]
   [OT:order_topology α]:is_closed {p:α × α|p.fst ≤ p.snd} :=
begin
  have A1:order_closed_topology α,
  {
    apply @order_topology.to_order_closed_topology,
  },
  apply A1.is_closed_le',
end

lemma measurable_set_of_le {α:Type*} [T:topological_space α]
      [SC:topological_space.second_countable_topology α] [P:linear_order α]
      [OT:order_topology α]:measurable_space.measurable_set'
      (@prod.measurable_space α α (borel α) (borel α))
      {p:α × α|p.fst ≤ p.snd} :=
begin
  apply is_closed_measurable_set_binary,
  apply is_closed_le_alt,
end

lemma measurable_set_of_eq {α:Type*} [T:topological_space α]
      [SC:topological_space.second_countable_topology α]
      [T2:t2_space α]:measurable_space.measurable_set'
      (@prod.measurable_space α α (borel α) (borel α))
      {p:α × α|p.fst = p.snd} :=
begin
  apply is_closed_measurable_set_binary,
  apply is_closed_diagonal,
end

lemma measurable_set_singleton_sc {α:Type*} [T:topological_space α]
      [SC:topological_space.second_countable_topology α]
      [T2:t2_space α]:∀ (a:α), measurable_space.measurable_set' (borel α)
      ({a}:set α) :=
begin
  intros a,
  apply measurable_set_of_is_closed,
  apply is_closed_singleton,
end


-- The following fails in the old elaborator
-- theorem tst1 : (fun a b => Nat.add a b) = Nat.add :=
-- Eq.refl (fun a b => Nat.add a b)

theorem tst2 : (fun a b => Nat.add a b) = Nat.add :=
Eq.refl (fun a b => Nat.add a b)

theorem tst3 : (fun a b => Nat.add a b) = Nat.add :=
rfl

theorem tst4 : Nat.add = (fun a b => Nat.add a b) :=
rfl

theorem tst5 : Nat.add = (fun (a b : Nat) => a + b) :=
rfl

theorem tst6 : Nat.add = (· + ·) :=
rfl

theorem tst7 : (· + ·) = Nat.add :=
rfl

theorem tst8 : (· + ·) = @Add.add Nat _ :=
rfl

theorem tst9 : (Nat.add · ·) = @Add.add Nat _ :=
rfl

axiom p    : (Nat → Nat → Nat) → Prop
axiom pAdd : p Nat.add

theorem tst10 : p (fun a b => Nat.add a b) :=
pAdd


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/

import linear_algebra.finite_dimensional
import ring_theory.integral_closure
import data.polynomial.integral_normalization

/-!
# Algebraic elements and algebraic extensions

An element of an R-algebra is algebraic over R if it is the root of a nonzero polynomial.
An R-algebra is algebraic over R if and only if all its elements are algebraic over R.
The main result in this file proves transitivity of algebraicity:
a tower of algebraic field extensions is algebraic.
-/

universe variables u v

open_locale classical
open polynomial

section
variables (R : Type u) {A : Type v} [comm_ring R] [ring A] [algebra R A]

/-- An element of an R-algebra is algebraic over R if it is the root of a nonzero polynomial. -/
def is_algebraic (x : A) : Prop :=
∃ p : polynomial R, p ≠ 0 ∧ aeval x p = 0

/-- An element of an R-algebra is transcendental over R if it is not algebraic over R. -/
def transcendental (x : A) : Prop := ¬ is_algebraic R x

variables {R}

/-- A subalgebra is algebraic if all its elements are algebraic. -/
def subalgebra.is_algebraic (S : subalgebra R A) : Prop := ∀ x ∈ S, is_algebraic R x

variables (R A)

/-- An algebra is algebraic if all its elements are algebraic. -/
def algebra.is_algebraic : Prop := ∀ x : A, is_algebraic R x

variables {R A}

/-- A subalgebra is algebraic if and only if it is algebraic an algebra. -/
lemma subalgebra.is_algebraic_iff (S : subalgebra R A) :
  S.is_algebraic ↔ @algebra.is_algebraic R S _ _ (S.algebra) :=
begin
  delta algebra.is_algebraic subalgebra.is_algebraic,
  rw [subtype.forall'],
  apply forall_congr, rintro ⟨x, hx⟩,
  apply exists_congr, intro p,
  apply and_congr iff.rfl,
  have h : function.injective (S.val) := subtype.val_injective,
  conv_rhs { rw [← h.eq_iff, alg_hom.map_zero], },
  rw [← aeval_alg_hom_apply, S.val_apply]
end

/-- An algebra is algebraic if and only if it is algebraic as a subalgebra. -/
lemma algebra.is_algebraic_iff : algebra.is_algebraic R A ↔ (⊤ : subalgebra R A).is_algebraic :=
begin
  delta algebra.is_algebraic subalgebra.is_algebraic,
  simp only [algebra.mem_top, forall_prop_of_true, iff_self],
end

end

section zero_ne_one
variables (R : Type u) {A : Type v} [comm_ring R] [nontrivial R] [ring A] [algebra R A]

/-- An integral element of an algebra is algebraic.-/
lemma is_integral.is_algebraic {x : A} (h : is_integral R x) : is_algebraic R x :=
by { rcases h with ⟨p, hp, hpx⟩, exact ⟨p, hp.ne_zero, hpx⟩ }

variables {R}

/-- An element of `R` is algebraic, when viewed as an element of the `R`-algebra `A`. -/
lemma is_algebraic_algebra_map (a : R) : is_algebraic R (algebra_map R A a) :=
⟨X - C a, X_sub_C_ne_zero a, by simp only [aeval_C, aeval_X, alg_hom.map_sub, sub_self]⟩

end zero_ne_one

section field
variables (K : Type u) {A : Type v} [field K] [ring A] [algebra K A]

/-- An element of an algebra over a field is algebraic if and only if it is integral.-/
lemma is_algebraic_iff_is_integral {x : A} :
  is_algebraic K x ↔ is_integral K x :=
begin
  refine ⟨_, is_integral.is_algebraic K⟩,
  rintro ⟨p, hp, hpx⟩,
  refine ⟨_, monic_mul_leading_coeff_inv hp, _⟩,
  rw [← aeval_def, alg_hom.map_mul, hpx, zero_mul],
end

lemma is_algebraic_iff_is_integral' :
  algebra.is_algebraic K A ↔ algebra.is_integral K A :=
⟨λ h x, (is_algebraic_iff_is_integral K).mp (h x),
  λ h x, (is_algebraic_iff_is_integral K).mpr (h x)⟩

end field

namespace algebra
variables {K : Type*} {L : Type*} {A : Type*}
variables [field K] [field L] [comm_ring A]
variables [algebra K L] [algebra L A] [algebra K A] [is_scalar_tower K L A]

/-- If L is an algebraic field extension of K and A is an algebraic algebra over L,
then A is algebraic over K. -/
lemma is_algebraic_trans (L_alg : is_algebraic K L) (A_alg : is_algebraic L A) :
  is_algebraic K A :=
begin
  simp only [is_algebraic, is_algebraic_iff_is_integral] at L_alg A_alg ⊢,
  exact is_integral_trans L_alg A_alg,
end

/-- A field extension is algebraic if it is finite. -/
lemma is_algebraic_of_finite [finite : finite_dimensional K L] : is_algebraic K L :=
λ x, (is_algebraic_iff_is_integral _).mpr (is_integral_of_submodule_noetherian ⊤
  (is_noetherian_of_submodule_of_noetherian _ _ _ finite) x algebra.mem_top)

end algebra

variables {R S : Type*} [integral_domain R] [comm_ring S]

lemma exists_integral_multiple [algebra R S] {z : S} (hz : is_algebraic R z)
  (inj : ∀ x, algebra_map R S x = 0 → x = 0) :
  ∃ (x : integral_closure R S) (y ≠ (0 : integral_closure R S)),
    z * y = x :=
begin
  rcases hz with ⟨p, p_ne_zero, px⟩,
  set a := p.leading_coeff with a_def,
  have a_ne_zero : a ≠ 0 := mt polynomial.leading_coeff_eq_zero.mp p_ne_zero,
  have y_integral : is_integral R (algebra_map R S a) := is_integral_algebra_map,
  have x_integral : is_integral R (z * algebra_map R S a) :=
    ⟨ p.integral_normalization,
      monic_integral_normalization p_ne_zero,
      integral_normalization_aeval_eq_zero px inj ⟩,
  refine ⟨⟨_, x_integral⟩, ⟨_, y_integral⟩, _, rfl⟩,
  exact λ h, a_ne_zero (inj _ (subtype.ext_iff_val.mp h))
end
section field

variables {K L : Type*} [field K] [field L] [algebra K L] (A : subalgebra K L)

lemma inv_eq_of_aeval_div_X_ne_zero {x : L} {p : polynomial K}
  (aeval_ne : aeval x (div_X p) ≠ 0) :
  x⁻¹ = aeval x (div_X p) / (aeval x p - algebra_map _ _ (p.coeff 0)) :=
begin
  rw [inv_eq_iff, inv_div, div_eq_iff, sub_eq_iff_eq_add, mul_comm],
  conv_lhs { rw ← div_X_mul_X_add p },
  rw [alg_hom.map_add, alg_hom.map_mul, aeval_X, aeval_C],
  exact aeval_ne
end

lemma inv_eq_of_root_of_coeff_zero_ne_zero {x : L} {p : polynomial K}
  (aeval_eq : aeval x p = 0) (coeff_zero_ne : p.coeff 0 ≠ 0) :
  x⁻¹ = - (aeval x (div_X p) / algebra_map _ _ (p.coeff 0)) :=
begin
  convert inv_eq_of_aeval_div_X_ne_zero (mt (λ h, (algebra_map K L).injective _) coeff_zero_ne),
  { rw [aeval_eq, zero_sub, div_neg] },
  rw ring_hom.map_zero,
  convert aeval_eq,
  conv_rhs { rw ← div_X_mul_X_add p },
  rw [alg_hom.map_add, alg_hom.map_mul, h, zero_mul, zero_add, aeval_C]
end

lemma subalgebra.inv_mem_of_root_of_coeff_zero_ne_zero {x : A} {p : polynomial K}
  (aeval_eq : aeval x p = 0) (coeff_zero_ne : p.coeff 0 ≠ 0) : (x⁻¹ : L) ∈ A :=
begin
  have : (x⁻¹ : L) = aeval x (div_X p) / (aeval x p - algebra_map _ _ (p.coeff 0)),
  { rw [aeval_eq, subalgebra.coe_zero, zero_sub, div_neg],
    convert inv_eq_of_root_of_coeff_zero_ne_zero _ coeff_zero_ne,
    { rw subalgebra.aeval_coe },
    { simpa using aeval_eq } },
  rw [this, div_eq_mul_inv, aeval_eq, subalgebra.coe_zero, zero_sub, ← ring_hom.map_neg,
      ← ring_hom.map_inv],
  exact A.mul_mem (aeval x p.div_X).2 (A.algebra_map_mem _),
end

lemma subalgebra.inv_mem_of_algebraic {x : A} (hx : is_algebraic K (x : L)) : (x⁻¹ : L) ∈ A :=
begin
  obtain ⟨p, ne_zero, aeval_eq⟩ := hx,
  rw [subalgebra.aeval_coe, subalgebra.coe_eq_zero] at aeval_eq,
  revert ne_zero aeval_eq,
  refine p.rec_on_horner _ _ _,
  { intro h,
    contradiction },
  { intros p a hp ha ih ne_zero aeval_eq,
    refine A.inv_mem_of_root_of_coeff_zero_ne_zero aeval_eq _,
    rwa [coeff_add, hp, zero_add, coeff_C, if_pos rfl] },
  { intros p hp ih ne_zero aeval_eq,
    rw [alg_hom.map_mul, aeval_X, mul_eq_zero] at aeval_eq,
    cases aeval_eq with aeval_eq x_eq,
    { exact ih hp aeval_eq },
    { rw [x_eq, subalgebra.coe_zero, inv_zero],
      exact A.zero_mem } }
end

/-- In an algebraic extension L/K, an intermediate subalgebra is a field. -/
lemma subalgebra.is_field_of_algebraic (hKL : algebra.is_algebraic K L) : is_field A :=
{ mul_inv_cancel := λ a ha, ⟨
        ⟨a⁻¹, A.inv_mem_of_algebraic (hKL a)⟩,
        subtype.ext (mul_inv_cancel (mt (subalgebra.coe_eq_zero _).mp ha))⟩,
  .. subalgebra.integral_domain A }

end field


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Callum Sutton, Yury Kudryashov
-/
import algebra.group.opposite
import algebra.hom.ring
import logic.equiv.set
import tactic.assert_exists

/-!
# (Semi)ring equivs

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

In this file we define extension of `equiv` called `ring_equiv`, which is a datatype representing an
isomorphism of `semiring`s, `ring`s, `division_ring`s, or `field`s. We also introduce the
corresponding group of automorphisms `ring_aut`.

## Notations

* ``infix ` ≃+* `:25 := ring_equiv``

The extended equiv have coercions to functions, and the coercion is the canonical notation when
treating the isomorphism as maps.

## Implementation notes

The fields for `ring_equiv` now avoid the unbundled `is_mul_hom` and `is_add_hom`, as these are
deprecated.

Definition of multiplication in the groups of automorphisms agrees with function composition,
multiplication in `equiv.perm`, and multiplication in `category_theory.End`, not with
`category_theory.comp`.

## Tags

equiv, mul_equiv, add_equiv, ring_equiv, mul_aut, add_aut, ring_aut
-/

variables {F α β R S S' : Type*}

set_option old_structure_cmd true

/-- An equivalence between two (non-unital non-associative semi)rings that preserves the
algebraic structure. -/
structure ring_equiv (R S : Type*) [has_mul R] [has_add R] [has_mul S] [has_add S]
  extends R ≃ S, R ≃* S, R ≃+ S

infix ` ≃+* `:25 := ring_equiv

/-- The "plain" equivalence of types underlying an equivalence of (semi)rings. -/
add_decl_doc ring_equiv.to_equiv

/-- The equivalence of additive monoids underlying an equivalence of (semi)rings. -/
add_decl_doc ring_equiv.to_add_equiv

/-- The equivalence of multiplicative monoids underlying an equivalence of (semi)rings. -/
add_decl_doc ring_equiv.to_mul_equiv

/-- `ring_equiv_class F R S` states that `F` is a type of ring structure preserving equivalences.
You should extend this class when you extend `ring_equiv`. -/
class ring_equiv_class (F : Type*) (R S : out_param Type*)
  [has_mul R] [has_add R] [has_mul S] [has_add S]
  extends mul_equiv_class F R S :=
(map_add : ∀ (f : F) a b, f (a + b) = f a + f b)

namespace ring_equiv_class

@[priority 100] -- See note [lower instance priority]
instance to_add_equiv_class (F R S : Type*)
  [has_mul R] [has_add R] [has_mul S] [has_add S] [h : ring_equiv_class F R S] :
  add_equiv_class F R S :=
{ coe := coe_fn,
  .. h }

@[priority 100] -- See note [lower instance priority]
instance to_ring_hom_class (F R S : Type*)
  [non_assoc_semiring R] [non_assoc_semiring S] [h : ring_equiv_class F R S] :
  ring_hom_class F R S :=
{ coe := coe_fn,
  coe_injective' := fun_like.coe_injective,
  map_zero := map_zero,
  map_one := map_one,
  .. h }

@[priority 100] -- See note [lower instance priority]
instance to_non_unital_ring_hom_class (F R S : Type*)
  [non_unital_non_assoc_semiring R] [non_unital_non_assoc_semiring S] [h : ring_equiv_class F R S] :
  non_unital_ring_hom_class F R S :=
{ coe := coe_fn,
  coe_injective' := fun_like.coe_injective,
  map_zero := map_zero,
  .. h }

end ring_equiv_class

instance [has_mul α] [has_add α] [has_mul β] [has_add β] [ring_equiv_class F α β] :
  has_coe_t F (α ≃+* β) :=
⟨λ f, { to_fun := f, inv_fun := equiv_like.inv f, left_inv := equiv_like.left_inv f,
  right_inv := equiv_like.right_inv f, map_mul' := map_mul f, map_add' := map_add f }⟩

namespace ring_equiv

section basic

variables [has_mul R] [has_add R] [has_mul S] [has_add S] [has_mul S'] [has_add S']

instance : ring_equiv_class (R ≃+* S) R S :=
{ coe := to_fun,
  inv := inv_fun,
  coe_injective' := λ e f h₁ h₂, by { cases e, cases f, congr' },
  map_add := map_add',
  map_mul := map_mul',
  left_inv := ring_equiv.left_inv,
  right_inv := ring_equiv.right_inv }

instance : has_coe_to_fun (R ≃+* S) (λ _, R → S) := ⟨ring_equiv.to_fun⟩

@[simp] lemma to_equiv_eq_coe (f : R ≃+* S) : f.to_equiv = f := rfl

@[simp] lemma to_fun_eq_coe (f : R ≃+* S) : f.to_fun = f := rfl

@[simp] lemma coe_to_equiv (f : R ≃+* S) : ⇑(f : R ≃ S) = f := rfl

/-- A ring isomorphism preserves multiplication. -/
protected lemma map_mul (e : R ≃+* S) (x y : R) : e (x * y) = e x * e y := map_mul e x y

/-- A ring isomorphism preserves addition. -/
protected lemma map_add (e : R ≃+* S) (x y : R) : e (x + y) = e x + e y := map_add e x y

/-- Two ring isomorphisms agree if they are defined by the
    same underlying function. -/
@[ext] lemma ext {f g : R ≃+* S} (h : ∀ x, f x = g x) : f = g := fun_like.ext f g h

@[simp] theorem coe_mk (e e' h₁ h₂ h₃ h₄) :
  ⇑(⟨e, e', h₁, h₂, h₃, h₄⟩ : R ≃+* S) = e := rfl

@[simp] theorem mk_coe (e : R ≃+* S) (e' h₁ h₂ h₃ h₄) :
  (⟨e, e', h₁, h₂, h₃, h₄⟩ : R ≃+* S) = e := ext $ λ _, rfl

protected lemma congr_arg {f : R ≃+* S} {x x' : R} : x = x' → f x = f x' := fun_like.congr_arg f

protected lemma congr_fun {f g : R ≃+* S} (h : f = g) (x : R) : f x = g x := fun_like.congr_fun h x

protected lemma ext_iff {f g : R ≃+* S} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff

@[simp] lemma to_add_equiv_eq_coe (f : R ≃+* S) : f.to_add_equiv = ↑f := rfl

@[simp] lemma to_mul_equiv_eq_coe (f : R ≃+* S) : f.to_mul_equiv = ↑f := rfl

@[simp, norm_cast] lemma coe_to_mul_equiv (f : R ≃+* S) : ⇑(f : R ≃* S) = f := rfl

@[simp, norm_cast] lemma coe_to_add_equiv (f : R ≃+* S) : ⇑(f : R ≃+ S) = f := rfl

/-- The `ring_equiv` between two semirings with a unique element. -/
def ring_equiv_of_unique {M N}
  [unique M] [unique N] [has_add M] [has_mul M] [has_add N] [has_mul N] : M ≃+* N :=
{ ..add_equiv.add_equiv_of_unique,
  ..mul_equiv.mul_equiv_of_unique}

instance {M N} [unique M] [unique N] [has_add M] [has_mul M] [has_add N] [has_mul N] :
  unique (M ≃+* N) :=
{ default := ring_equiv_of_unique,
  uniq := λ _, ext $ λ x, subsingleton.elim _ _ }

variable (R)

/-- The identity map is a ring isomorphism. -/
@[refl] protected def refl : R ≃+* R := { .. mul_equiv.refl R, .. add_equiv.refl R }

@[simp] lemma refl_apply (x : R) : ring_equiv.refl R x = x := rfl

@[simp] lemma coe_add_equiv_refl : (ring_equiv.refl R : R ≃+ R) = add_equiv.refl R := rfl

@[simp] lemma coe_mul_equiv_refl : (ring_equiv.refl R : R ≃* R) = mul_equiv.refl R := rfl

instance : inhabited (R ≃+* R) := ⟨ring_equiv.refl R⟩

variables {R}

/-- The inverse of a ring isomorphism is a ring isomorphism. -/
@[symm] protected def symm (e : R ≃+* S) : S ≃+* R :=
{ .. e.to_mul_equiv.symm, .. e.to_add_equiv.symm }

/-- See Note [custom simps projection] -/
def simps.symm_apply (e : R ≃+* S) : S → R := e.symm

initialize_simps_projections ring_equiv (to_fun → apply, inv_fun → symm_apply)

@[simp] lemma inv_fun_eq_symm (f : R ≃+* S) : f.inv_fun = f.symm := rfl

@[simp] lemma symm_symm (e : R ≃+* S) : e.symm.symm = e := ext $ λ x, rfl

@[simp]
lemma coe_to_equiv_symm (e : R ≃+* S) : (e.symm : S ≃ R) = (e : R ≃ S).symm := rfl

lemma symm_bijective : function.bijective (ring_equiv.symm : (R ≃+* S) → (S ≃+* R)) :=
equiv.bijective ⟨ring_equiv.symm, ring_equiv.symm, symm_symm, symm_symm⟩

@[simp] lemma mk_coe' (e : R ≃+* S) (f h₁ h₂ h₃ h₄) :
  (ring_equiv.mk f ⇑e h₁ h₂ h₃ h₄ : S ≃+* R) = e.symm :=
symm_bijective.injective $ ext $ λ x, rfl

@[simp] lemma symm_mk (f : R → S) (g h₁ h₂ h₃ h₄) :
  (mk f g h₁ h₂ h₃ h₄).symm =
  { to_fun := g, inv_fun := f, ..(mk f g h₁ h₂ h₃ h₄).symm} := rfl

/-- Transitivity of `ring_equiv`. -/
@[trans] protected def trans (e₁ : R ≃+* S) (e₂ : S ≃+* S') : R ≃+* S' :=
{ .. (e₁.to_mul_equiv.trans e₂.to_mul_equiv), .. (e₁.to_add_equiv.trans e₂.to_add_equiv) }

lemma trans_apply (e₁ : R ≃+* S) (e₂ : S ≃+* S') (a : R) :
  e₁.trans e₂ a = e₂ (e₁ a) := rfl

@[simp] lemma coe_trans (e₁ : R ≃+* S) (e₂ : S ≃+* S') :
  (e₁.trans e₂ : R → S') = e₂ ∘ e₁ := rfl

@[simp]
lemma symm_trans_apply (e₁ : R ≃+* S) (e₂ : S ≃+* S') (a : S') :
  (e₁.trans e₂).symm a = e₁.symm (e₂.symm a) := rfl

lemma symm_trans (e₁ : R ≃+* S) (e₂ : S ≃+* S') :
  (e₁.trans e₂).symm = e₂.symm.trans (e₁.symm) := rfl

protected lemma bijective (e : R ≃+* S) : function.bijective e := equiv_like.bijective e
protected lemma injective (e : R ≃+* S) : function.injective e := equiv_like.injective e
protected lemma surjective (e : R ≃+* S) : function.surjective e := equiv_like.surjective e

@[simp] lemma apply_symm_apply (e : R ≃+* S) : ∀ x, e (e.symm x) = x := e.to_equiv.apply_symm_apply
@[simp] lemma symm_apply_apply (e : R ≃+* S) : ∀ x, e.symm (e x) = x := e.to_equiv.symm_apply_apply

lemma image_eq_preimage (e : R ≃+* S) (s : set R) : e '' s = e.symm ⁻¹' s :=
e.to_equiv.image_eq_preimage s

@[simp] lemma coe_mul_equiv_trans (e₁ : R ≃+* S) (e₂ : S ≃+* S') :
  (e₁.trans e₂ : R ≃* S') = (e₁ : R ≃* S).trans ↑e₂:= rfl
@[simp] lemma coe_add_equiv_trans (e₁ : R ≃+* S) (e₂ : S ≃+* S') :
  (e₁.trans e₂ : R ≃+ S') = (e₁ : R ≃+ S).trans ↑e₂:= rfl

end basic

section opposite
open mul_opposite

/-- A ring iso `α ≃+* β` can equivalently be viewed as a ring iso `αᵐᵒᵖ ≃+* βᵐᵒᵖ`. -/
@[simps]
protected def op {α β} [has_add α] [has_mul α] [has_add β] [has_mul β] :
  (α ≃+* β) ≃ (αᵐᵒᵖ ≃+* βᵐᵒᵖ) :=
{ to_fun    := λ f, { ..f.to_add_equiv.mul_op, ..f.to_mul_equiv.op},
  inv_fun   := λ f, { ..add_equiv.mul_op.symm f.to_add_equiv, ..mul_equiv.op.symm f.to_mul_equiv },
  left_inv  := λ f, by { ext, refl },
  right_inv := λ f, by { ext, refl } }

/-- The 'unopposite' of a ring iso `αᵐᵒᵖ ≃+* βᵐᵒᵖ`. Inverse to `ring_equiv.op`. -/
@[simp] protected def unop {α β} [has_add α] [has_mul α] [has_add β] [has_mul β] :
  (αᵐᵒᵖ ≃+* βᵐᵒᵖ) ≃ (α ≃+* β) := ring_equiv.op.symm

section non_unital_comm_semiring

variables (R) [non_unital_comm_semiring R]

/-- A non-unital commutative ring is isomorphic to its opposite. -/
def to_opposite : R ≃+* Rᵐᵒᵖ :=
{ map_add' := λ x y, rfl,
  map_mul' := λ x y, mul_comm (op y) (op x),
  .. mul_opposite.op_equiv }

@[simp]
lemma to_opposite_apply (r : R) : to_opposite R r = op r := rfl

@[simp]
lemma to_opposite_symm_apply (r : Rᵐᵒᵖ) : (to_opposite R).symm r = unop r := rfl

end non_unital_comm_semiring

end opposite

section non_unital_semiring

variables [non_unital_non_assoc_semiring R] [non_unital_non_assoc_semiring S]
  (f : R ≃+* S) (x y : R)

/-- A ring isomorphism sends zero to zero. -/
protected lemma map_zero : f 0 = 0 := map_zero f

variable {x}

protected lemma map_eq_zero_iff : f x = 0 ↔ x = 0 := add_equiv_class.map_eq_zero_iff f

lemma map_ne_zero_iff : f x ≠ 0 ↔ x ≠ 0 := add_equiv_class.map_ne_zero_iff f

/-- Produce a ring isomorphism from a bijective ring homomorphism. -/
noncomputable def of_bijective [non_unital_ring_hom_class F R S] (f : F)
  (hf : function.bijective f) : R ≃+* S :=
{ map_mul' := map_mul f,
  map_add' := map_add f,
  .. equiv.of_bijective f hf,}

@[simp] lemma coe_of_bijective [non_unital_ring_hom_class F R S] (f : F)
  (hf : function.bijective f) : (of_bijective f hf : R → S) = f := rfl

lemma of_bijective_apply [non_unital_ring_hom_class F R S] (f : F)
  (hf : function.bijective f) (x : R) : of_bijective f hf x = f x := rfl

/-- A family of ring isomorphisms `Π j, (R j ≃+* S j)` generates a
ring isomorphisms between `Π j, R j` and `Π j, S j`.

This is the `ring_equiv` version of `equiv.Pi_congr_right`, and the dependent version of
`ring_equiv.arrow_congr`.
-/
@[simps apply]
def Pi_congr_right {ι : Type*} {R S : ι → Type*}
  [Π i, non_unital_non_assoc_semiring (R i)] [Π i, non_unital_non_assoc_semiring (S i)]
  (e : Π i, R i ≃+* S i) : (Π i, R i) ≃+* Π i, S i :=
{ to_fun := λ x j, e j (x j),
  inv_fun := λ x j, (e j).symm (x j),
  .. @mul_equiv.Pi_congr_right ι R S _ _ (λ i, (e i).to_mul_equiv),
  .. @add_equiv.Pi_congr_right ι R S _ _ (λ i, (e i).to_add_equiv) }

@[simp]
lemma Pi_congr_right_refl {ι : Type*} {R : ι → Type*} [Π i, non_unital_non_assoc_semiring (R i)] :
  Pi_congr_right (λ i, ring_equiv.refl (R i)) = ring_equiv.refl _ := rfl

@[simp]
lemma Pi_congr_right_symm {ι : Type*} {R S : ι → Type*}
  [Π i, non_unital_non_assoc_semiring (R i)] [Π i, non_unital_non_assoc_semiring (S i)]
  (e : Π i, R i ≃+* S i) : (Pi_congr_right e).symm = (Pi_congr_right $ λ i, (e i).symm) := rfl

@[simp]
lemma Pi_congr_right_trans {ι : Type*} {R S T : ι → Type*}
  [Π i, non_unital_non_assoc_semiring (R i)] [Π i, non_unital_non_assoc_semiring (S i)]
  [Π i, non_unital_non_assoc_semiring (T i)]
  (e : Π i, R i ≃+* S i) (f : Π i, S i ≃+* T i) :
  (Pi_congr_right e).trans (Pi_congr_right f) = (Pi_congr_right $ λ i, (e i).trans (f i)) := rfl

end non_unital_semiring

section semiring

variables [non_assoc_semiring R] [non_assoc_semiring S] (f : R ≃+* S) (x y : R)

/-- A ring isomorphism sends one to one. -/
protected lemma map_one : f 1 = 1 := map_one f

variable {x}

protected lemma map_eq_one_iff : f x = 1 ↔ x = 1 := mul_equiv_class.map_eq_one_iff f

lemma map_ne_one_iff : f x ≠ 1 ↔ x ≠ 1 := mul_equiv_class.map_ne_one_iff f

lemma coe_monoid_hom_refl : (ring_equiv.refl R : R →* R) = monoid_hom.id R := rfl
@[simp] lemma coe_add_monoid_hom_refl : (ring_equiv.refl R : R →+ R) = add_monoid_hom.id R := rfl
/-! `ring_equiv.coe_mul_equiv_refl` and `ring_equiv.coe_add_equiv_refl` are proved above
in higher generality -/
@[simp] lemma coe_ring_hom_refl : (ring_equiv.refl R : R →* R) = ring_hom.id R := rfl

@[simp] lemma coe_monoid_hom_trans [non_assoc_semiring S'] (e₁ : R ≃+* S) (e₂ : S ≃+* S') :
  (e₁.trans e₂ : R →* S') = (e₂ : S →* S').comp ↑e₁ := rfl
@[simp] lemma coe_add_monoid_hom_trans [non_assoc_semiring S'] (e₁ : R ≃+* S) (e₂ : S ≃+* S') :
  (e₁.trans e₂ : R →+ S') = (e₂ : S →+ S').comp ↑e₁ := rfl
/-! `ring_equiv.coe_mul_equiv_trans` and `ring_equiv.coe_add_equiv_trans` are proved above
in higher generality -/
@[simp] lemma coe_ring_hom_trans [non_assoc_semiring S'] (e₁ : R ≃+* S) (e₂ : S ≃+* S') :
  (e₁.trans e₂ : R →+* S') = (e₂ : S →+* S').comp ↑e₁ := rfl

@[simp] lemma comp_symm (e : R ≃+* S) :
  (e : R →+* S).comp (e.symm : S →+* R) = ring_hom.id S :=
ring_hom.ext e.apply_symm_apply

@[simp] lemma symm_comp (e : R ≃+* S) :
  (e.symm : S →+* R).comp (e : R →+* S) = ring_hom.id R :=
ring_hom.ext e.symm_apply_apply

end semiring

section non_unital_ring

variables [non_unital_non_assoc_ring R] [non_unital_non_assoc_ring S] (f : R ≃+* S) (x y : R)

protected lemma map_neg : f (-x) = -f x := map_neg f x

protected lemma map_sub : f (x - y) = f x - f y := map_sub f x y

end non_unital_ring

section ring

variables [non_assoc_ring R] [non_assoc_ring S] (f : R ≃+* S) (x y : R)

@[simp] lemma map_neg_one : f (-1) = -1 := f.map_one ▸ f.map_neg 1

end ring

section non_unital_semiring_hom

variables [non_unital_non_assoc_semiring R] [non_unital_non_assoc_semiring S]
  [non_unital_non_assoc_semiring S']

/-- Reinterpret a ring equivalence as a non-unital ring homomorphism. -/
def to_non_unital_ring_hom (e : R ≃+* S) : R →ₙ+* S :=
{ .. e.to_mul_equiv.to_mul_hom, .. e.to_add_equiv.to_add_monoid_hom }

lemma to_non_unital_ring_hom_injective :
  function.injective (to_non_unital_ring_hom : (R ≃+* S) → R →ₙ+* S) :=
λ f g h, ring_equiv.ext (non_unital_ring_hom.ext_iff.1 h)

/- The instance priority is lowered here so that in the case when `R` and `S` are both unital, Lean
will first find and use `ring_equiv.has_coe_to_ring_hom`. -/
@[priority 900]
instance has_coe_to_non_unital_ring_hom : has_coe (R ≃+* S) (R →ₙ+* S) :=
⟨ring_equiv.to_non_unital_ring_hom⟩

lemma to_non_unital_ring_hom_eq_coe (f : R ≃+* S) : f.to_non_unital_ring_hom = ↑f := rfl

@[simp, norm_cast] lemma coe_to_non_unital_ring_hom (f : R ≃+* S) : ⇑(f : R →ₙ+* S) = f := rfl

lemma coe_non_unital_ring_hom_inj_iff {R S : Type*}
  [non_unital_non_assoc_semiring R] [non_unital_non_assoc_semiring S]
  (f g : R ≃+* S) :
  f = g ↔ (f : R →ₙ+* S) = g :=
⟨congr_arg _, λ h, ext $ non_unital_ring_hom.ext_iff.mp h⟩

@[simp]
lemma to_non_unital_ring_hom_refl :
  (ring_equiv.refl R).to_non_unital_ring_hom = non_unital_ring_hom.id R := rfl

@[simp]
lemma to_non_unital_ring_hom_apply_symm_to_non_unital_ring_hom_apply (e : R ≃+* S) :
  ∀ (y : S), e.to_non_unital_ring_hom (e.symm.to_non_unital_ring_hom y) = y :=
e.to_equiv.apply_symm_apply

@[simp]
lemma symm_to_non_unital_ring_hom_apply_to_non_unital_ring_hom_apply (e : R ≃+* S) :
  ∀ (x : R), e.symm.to_non_unital_ring_hom (e.to_non_unital_ring_hom x) = x :=
equiv.symm_apply_apply (e.to_equiv)

@[simp]
lemma to_non_unital_ring_hom_trans (e₁ : R ≃+* S) (e₂ : S ≃+* S') :
  (e₁.trans e₂).to_non_unital_ring_hom = e₂.to_non_unital_ring_hom.comp e₁.to_non_unital_ring_hom :=
rfl

@[simp]

@[simp]
lemma symm_to_non_unital_ring_hom_comp_to_non_unital_ring_hom (e : R ≃+* S) :
  e.symm.to_non_unital_ring_hom.comp e.to_non_unital_ring_hom = non_unital_ring_hom.id _ :=
by { ext, simp }
end non_unital_semiring_hom

section semiring_hom

variables [non_assoc_semiring R] [non_assoc_semiring S] [non_assoc_semiring S']

/-- Reinterpret a ring equivalence as a ring homomorphism. -/
def to_ring_hom (e : R ≃+* S) : R →+* S :=
{ .. e.to_mul_equiv.to_monoid_hom, .. e.to_add_equiv.to_add_monoid_hom }

lemma to_ring_hom_injective : function.injective (to_ring_hom : (R ≃+* S) → R →+* S) :=
λ f g h, ring_equiv.ext (ring_hom.ext_iff.1 h)

instance has_coe_to_ring_hom : has_coe (R ≃+* S) (R →+* S) := ⟨ring_equiv.to_ring_hom⟩

lemma to_ring_hom_eq_coe (f : R ≃+* S) : f.to_ring_hom = ↑f := rfl

@[simp, norm_cast] lemma coe_to_ring_hom (f : R ≃+* S) : ⇑(f : R →+* S) = f := rfl

lemma coe_ring_hom_inj_iff {R S : Type*} [non_assoc_semiring R] [non_assoc_semiring S]
  (f g : R ≃+* S) :
  f = g ↔ (f : R →+* S) = g :=
⟨congr_arg _, λ h, ext $ ring_hom.ext_iff.mp h⟩

/-- The two paths coercion can take to a `non_unital_ring_hom` are equivalent -/
@[simp, norm_cast] lemma to_non_unital_ring_hom_commutes (f : R ≃+* S) :
  ((f : R →+* S) : R →ₙ+* S) = (f : R →ₙ+* S) :=
rfl

/-- Reinterpret a ring equivalence as a monoid homomorphism. -/
abbreviation to_monoid_hom (e : R ≃+* S) : R →* S := e.to_ring_hom.to_monoid_hom

/-- Reinterpret a ring equivalence as an `add_monoid` homomorphism. -/
abbreviation to_add_monoid_hom (e : R ≃+* S) : R →+ S := e.to_ring_hom.to_add_monoid_hom

/-- The two paths coercion can take to an `add_monoid_hom` are equivalent -/
lemma to_add_monoid_hom_commutes (f : R ≃+* S) :
  (f : R →+* S).to_add_monoid_hom = (f : R ≃+ S).to_add_monoid_hom :=
rfl

/-- The two paths coercion can take to an `monoid_hom` are equivalent -/
lemma to_monoid_hom_commutes (f : R ≃+* S) :
  (f : R →+* S).to_monoid_hom = (f : R ≃* S).to_monoid_hom :=
rfl

/-- The two paths coercion can take to an `equiv` are equivalent -/
lemma to_equiv_commutes (f : R ≃+* S) :
  (f : R ≃+ S).to_equiv = (f : R ≃* S).to_equiv :=
rfl

@[simp]
lemma to_ring_hom_refl : (ring_equiv.refl R).to_ring_hom = ring_hom.id R := rfl

@[simp]
lemma to_monoid_hom_refl : (ring_equiv.refl R).to_monoid_hom = monoid_hom.id R := rfl

@[simp]
lemma to_add_monoid_hom_refl : (ring_equiv.refl R).to_add_monoid_hom = add_monoid_hom.id R := rfl

@[simp]
lemma to_ring_hom_apply_symm_to_ring_hom_apply (e : R ≃+* S) :
  ∀ (y : S), e.to_ring_hom (e.symm.to_ring_hom y) = y :=
e.to_equiv.apply_symm_apply

@[simp]
lemma symm_to_ring_hom_apply_to_ring_hom_apply (e : R ≃+* S) :
  ∀ (x : R), e.symm.to_ring_hom (e.to_ring_hom x) = x :=
equiv.symm_apply_apply (e.to_equiv)

@[simp]
lemma to_ring_hom_trans (e₁ : R ≃+* S) (e₂ : S ≃+* S') :
  (e₁.trans e₂).to_ring_hom = e₂.to_ring_hom.comp e₁.to_ring_hom := rfl

@[simp]
lemma to_ring_hom_comp_symm_to_ring_hom (e : R ≃+* S) :
  e.to_ring_hom.comp e.symm.to_ring_hom = ring_hom.id _ :=
by { ext, simp }

@[simp]
lemma symm_to_ring_hom_comp_to_ring_hom (e : R ≃+* S) :
  e.symm.to_ring_hom.comp e.to_ring_hom = ring_hom.id _ :=
by { ext, simp }

/--
Construct an equivalence of rings from homomorphisms in both directions, which are inverses.
-/
@[simps]
def of_hom_inv' {R S F G : Type*} [non_unital_non_assoc_semiring R]
  [non_unital_non_assoc_semiring S] [non_unital_ring_hom_class F R S]
  [non_unital_ring_hom_class G S R] (hom : F) (inv : G)
  (hom_inv_id : (inv : S →ₙ+* R).comp (hom : R →ₙ+* S) = non_unital_ring_hom.id R)
  (inv_hom_id : (hom : R →ₙ+* S).comp (inv : S →ₙ+* R) = non_unital_ring_hom.id S) :
  R ≃+* S :=
{ to_fun := hom,
  inv_fun := inv,
  left_inv := fun_like.congr_fun hom_inv_id,
  right_inv := fun_like.congr_fun inv_hom_id,
  map_mul' := map_mul hom,
  map_add' := map_add hom, }

/--
Construct an equivalence of rings from unital homomorphisms in both directions, which are inverses.
-/
@[simps]
def of_hom_inv {R S F G : Type*} [non_assoc_semiring R] [non_assoc_semiring S]
  [ring_hom_class F R S] [ring_hom_class G S R] (hom : F) (inv : G)
  (hom_inv_id : (inv : S →+* R).comp (hom : R →+* S) = ring_hom.id R)
  (inv_hom_id : (hom : R →+* S).comp (inv : S →+* R) = ring_hom.id S) :
  R ≃+* S :=
{ to_fun := hom,
  inv_fun := inv,
  left_inv := fun_like.congr_fun hom_inv_id,
  right_inv := fun_like.congr_fun inv_hom_id,
  map_mul' := map_mul hom,
  map_add' := map_add hom, }

end semiring_hom

section group_power

variables [semiring R] [semiring S]

protected lemma map_pow (f : R ≃+* S) (a) : ∀ n : ℕ, f (a ^ n) = (f a) ^ n := map_pow f a

end group_power

end ring_equiv

namespace mul_equiv

/-- Gives a `ring_equiv` from an element of a `mul_equiv_class` preserving addition.-/
def to_ring_equiv {R S F : Type*} [has_add R] [has_add S] [has_mul R] [has_mul S]
  [mul_equiv_class F R S] (f : F) (H : ∀ x y : R, f (x + y) = f x + f y) : R ≃+* S :=
{ ..(f : R ≃* S).to_equiv, ..(f : R ≃* S), ..add_equiv.mk' (f : R ≃* S).to_equiv H }

end mul_equiv

namespace add_equiv

/-- Gives a `ring_equiv` from an element of an `add_equiv_class` preserving addition.-/
def to_ring_equiv {R S F : Type*} [has_add R] [has_add S] [has_mul R] [has_mul S]
  [add_equiv_class F R S] (f : F) (H : ∀ x y : R, f (x * y) = f x * f y) : R ≃+* S :=
{ ..(f : R ≃+ S).to_equiv, ..(f : R ≃+ S), ..mul_equiv.mk' (f : R ≃+ S).to_equiv H }

end add_equiv

namespace ring_equiv

variables [has_add R] [has_add S] [has_mul R] [has_mul S]

@[simp] theorem self_trans_symm (e : R ≃+* S) : e.trans e.symm = ring_equiv.refl R := ext e.3
@[simp] theorem symm_trans_self (e : R ≃+* S) : e.symm.trans e = ring_equiv.refl S := ext e.4

/-- If two rings are isomorphic, and the second doesn't have zero divisors,
then so does the first. -/
protected lemma no_zero_divisors
  {A : Type*} (B : Type*) [ring A] [ring B] [no_zero_divisors B]
  (e : A ≃+* B) : no_zero_divisors A :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := λ x y hxy,
    have e x * e y = 0, by rw [← e.map_mul, hxy, e.map_zero],
    by simpa using eq_zero_or_eq_zero_of_mul_eq_zero this }

/-- If two rings are isomorphic, and the second is a domain, then so is the first. -/
protected lemma is_domain
  {A : Type*} (B : Type*) [ring A] [ring B] [is_domain B]
  (e : A ≃+* B) : is_domain A :=
begin
  haveI : nontrivial A := ⟨⟨e.symm 0, e.symm 1, e.symm.injective.ne zero_ne_one⟩⟩,
  haveI := e.no_zero_divisors B,
  exact no_zero_divisors.to_is_domain _
end

end ring_equiv

-- Guard against import creep
assert_not_exists fintype