import data.rel
import data.set.finite
import data.sym.sym2
import set_theory.cardinal.finite
import algebra.big_operators.finprod

open_locale classical big_operators

noncomputable theory

open finset
universes u v w

variables {V : Type u} {E : Type v}

structure graph (V : Type u) (E : Type v) :=
(ends : E → sym2 V)

namespace graph

section basic

variables {G : graph V E} {u v : V} {e f : E}

def adj (G : graph V E) : V → V → Prop :=
  λ v w, ∃ (e : E), G.ends e = ⟦(v, w)⟧

def inc (G : graph V E) : V → E → Prop :=
  λ v e, v ∈ G.ends e

/-- Set of edges incident to a given vertex, aka incidence set. -/
def incidence_set (G : graph V E) (v : V) : set E := {e : E | v ∈ G.ends e}

/-- Make a graph from the digraph -/
def graph.mk {V : Type u} {E : Type v} (ends : E → sym2 V) : graph V E := { ends := ends }

@[symm] lemma adj_symm (h : G.adj u v) : G.adj v u :=
begin
  dunfold adj at *,
  rwa [sym2.eq_swap],
end

/-!
A dart is an edge with a chosen orientation - graphs are naturally unoriented,
but in order to talk about things like walks, the handshaking lemma, etc you have to
pick a "direction" to traverse the edges.
-/
structure dart (G : graph V E) : Type (max u v) :=
(head : V)
(tail : V)
(e : E)
(h : G.ends e = ⟦(head, tail)⟧)

/-!
Flipping a dart around
-/
def reverse_dart (G : graph V E) (d : G.dart) : G.dart :=
{ head := d.tail,
  tail := d.head,
  e := d.e,
  h := by {
    rw [sym2.eq_swap],
    exact d.h,
  } }

@[simp]
lemma reverse_head_tail (G : graph V E) (d : G.dart) : (G.reverse_dart d).tail = d.head :=
begin
  refl,
end

@[simp]
lemma reverse_tail_head (G : graph V E) (d : G.dart) : (G.reverse_dart d).head = d.tail :=
begin
  refl,
end

end basic

section walks

variables (G : graph V E)
/-!
We have a very clever definition of walks here that one of my colleagues at Waterloo
came up with. One of the issues we had when talk about walks was, when we'd try to talk
about them in an inductive way, we'd end up missing the start or end vertex. This definition
includes both in a neat way.
-/
structure walk (G : graph V E) : Type (max u v) :=
(head : V)
(tail : V)
(darts : list G.dart)
(is_walk :
  [head] ++ (list.map dart.tail darts)
  = (list.map dart.head darts) ++ [tail])

lemma walk_rev_head (p : walk G) :
  list.map dart.head (list.map G.reverse_dart p.darts) =
    (list.map dart.tail p.darts) :=
begin
  finish,
end

lemma walk_rev_tail (p : walk G) :
  list.map dart.tail (list.map G.reverse_dart p.darts) =
    (list.map dart.head p.darts) :=
begin
  finish,
end

/-!
Having seen how to write some definitions, try writing the definition of
the empty walk! Hint: By our definition, we do need a start and end vertex, so
we have to use arbitrary vertex v.
-/
def empty_walk (v : V) : walk G :=
{ head := v,
  tail := v,
  darts := [],
  is_walk := rfl }

/-!
The reverse of a walk p.
-/
def reverse (p : walk G) : walk G :=
{ head := p.tail,
  tail := p.head,
  darts := (list.map G.reverse_dart p.darts.reverse),
  -- including the above because you probably haven't seen lists in lean yet (?)
  is_walk :=
    begin
      rcases p with ⟨head, tail, darts, is_walk⟩,
      simp only [list.map_reverse, list.map_map, list.singleton_append],
      change [tail].reverse ++ (list.map dart.head darts).reverse =
        (list.map dart.tail darts).reverse ++ [head].reverse,
      rw [←list.reverse_append, ←list.reverse_append, list.reverse_inj],
      tauto,
    end }

/-!
Appending two walks p and q, where the tail of p is the head of q.
-/
def append (p q : walk G) (h : p.tail = q.head) : walk G :=
{ head := p.head,
  tail := q.tail,
  darts := p.darts ++ q.darts,
  is_walk :=
    begin
      rw [list.map_append, list.map_append, list.append_assoc, ←list.append_assoc,
          p.is_walk, ←q.is_walk, h, list.append_assoc],
    end }

/-!
We have reachable as a definition here so that we can start talking about connectivity.
You'll find that the previous definitions of various walks are useful in showing that
reachability is an equivalence relation:
-/
def reachable (u v : V) : Prop := ∃ (p : G.walk), p.head = u ∧ p.tail = v

namespace walk

/-!
Reachability is reflexive, i.e. a vertex can reach itself
-/
@[refl] protected lemma reachable.refl (u : V) : G.reachable u u :=
begin
  use empty_walk G u,
  tauto,
end
protected lemma reachable.rfl {u : V} : G.reachable u u := reachable.refl _ _

/-!
If you have a walk from u to v, you have a walk from v to u
-/
@[symm] protected lemma reachable.symm {u v : V} (huv : G.reachable u v) : G.reachable v u :=
begin
  rcases huv with ⟨w, h₁, h₂⟩,
  use reverse G w,
  tauto,
end

/-!
If you have a walk from u to v and a walk from v to w, then you have a walk from
u to w
-/
@[trans] protected lemma reachable.trans {u v w : V} (huv : G.reachable u v) (hvw : G.reachable v w)
  : G.reachable u w :=
begin
  rcases huv with ⟨w₁, h₁, h₂⟩,
  rcases hvw with ⟨w₂, h₃, h₄⟩,
  use append G w₁ w₂ (by finish),
  tauto,
end

def edges {G : graph V E} (p : G.walk) : list E := list.map dart.e p.darts

def support {G : graph V E} (p : G.walk) : list V := [p.head] ++ list.map dart.head p.darts

/-! ### Trails, paths, circuits, cycles -/

/-- A *trail* is a walk with no repeating edges. -/
structure is_trail {G : graph V E} (p : G.walk) : Prop :=
(edges_nodup : p.edges.nodup)

/-- A *path* is a walk with no repeating vertices. -/
structure is_path {G : graph V E} (p : G.walk) : Prop :=
(support_nodup : p.support.nodup)

/-- A *circuit* is a nonempty trail beginning and ending at the same vertex. -/
-- extends path & need to get rid of loops
structure is_circuit {G : graph V E} (p : G.walk) : Prop :=
(start_end : p.head = p.tail)
(ne_nil : p.darts ≠ [])

/-- A *cycle* at `u : V` is a circuit at `u` whose only repeating vertex
is `u` (which appears exactly twice). -/
structure is_cycle {G : graph V E} (p : G.walk) : Prop :=
(support_nodup : p.support.tail.nodup)

end walk

end walks

section conn

def connected (G : graph V E) : Prop := ∀ u v : V, G.reachable u v

def is_loop_edge_of (G : graph V E) (v : V) (e : E) : Prop := G.ends e = sym2.diag v

def is_loop_edge (G : graph V E) (e : E) : Prop := sym2.is_diag (G.ends e)

def degree (G : graph V E) (v : V) : ℕ := nat.card (G.incidence_set v)
  + nat.card {e | G.is_loop_edge_of v e}
-- double count loop edges

/-!
This is a harder problem so don't sweat it - honestly I haven't even proven this
version of the handshaking lemma yet! We do have the handshaking lemma in lean,
it just has a different appearance due to different definitions.
-/

def degree' (V : Type u) (E' : sym2 V → Type v) (v : V) : ℕ
  := nat.card (Σ v', E' ⟦(v, v')⟧) + nat.card (E' ⟦(v, v)⟧)

def aux₁ (G : E → sym2 V) (v : V) :
  {x // v ∈ G x} ≃ (Σ (v' : V), {e // G e = ⟦(v, v')⟧}) :=
  {
    to_fun := (λ e, begin
      rcases e with ⟨e, h⟩,
      let v' := sym2.mem.other h,
      refine ⟨v', ⟨e, _⟩⟩,
      simp only [sym2.other_spec],
    end),
    inv_fun := (λ e, begin
      rcases e with ⟨v', e, h⟩,
      use e,
      simp only [h, sym2.mem_iff, eq_self_iff_true, true_or],
    end),
    left_inv := by {
      rintro ⟨e, h⟩,
      simp only,
    },
    right_inv := by {
      rintro ⟨v', e, h⟩,
      sorry,

    }
  }

def degree_agree (G : graph V E) (v : V) :
  G.degree v = degree' V (λ p, { e : E // G.ends e = p }) v :=
begin
  cases G,
  simp [degree, degree', incidence_set, is_loop_edge_of],
  sorry,
end

-- lemma handshake' {m n} (G : graph (fin m) (fin n)) :
--   ∑ᶠ (x : fin m), degree' (fin n) x = 2 * n :=
-- begin
--   sorry,
-- end

lemma finsum_zero {X} [add_comm_monoid X] (f : fin 0 → X) :
  ∑ (v : fin 0), f v = 0 := rfl

lemma finset_step_aux {n} : (fintype.elems (fin (n + 1))).val = (fintype.elems (fin n)).val.map
  fin.cast_succ + {fin.last n} :=
begin
  rw [multiset.nodup.ext],
  intros v,
  change v ∈ (fintype.elems (fin (n + 1))) ↔ _,
  simp [fintype.complete],
  cases lt_or_eq_of_le v.le_last,
  cases n, simp at *,
  use v.cast_pred,
  change v.cast_pred ∈ (fintype.elems (fin n.succ)) ∧ _,
  simp [fintype.complete],
  exact fin.cast_succ_cast_pred h,
  cc,
  refine (fintype.elems _).nodup,
  rw [multiset.nodup.add_iff],
  simp, intros x h h',
  have h'' := fin.cast_succ_lt_last x,
  rw h' at h'', simp at *, assumption,
  apply multiset.nodup.map,
  exact rel_embedding.injective fin.cast_succ,
  refine (fintype.elems _).nodup,
  simp,
end

lemma finsum_step {X n} [add_comm_monoid X] (f : fin (n + 1) → X) :
  ∑ (v : fin (n + 1)), f v = (∑ (v : fin n), f (v.cast_succ)) + f (fin.last n) :=
begin
  simp only,
  change univ.sum f = univ.sum (f ∘ fin.cast_succ) + f (fin.last n),
  dsimp [finset.sum],
  nth_rewrite 1 [←multiset.map_map],
  have h₁ : f (fin.last n) = (multiset.map f {fin.last n}).sum := by simp,
  simp_rw [h₁], clear h₁,
  simp_rw [←multiset.sum_add],
  congr,
  simp_rw [←multiset.map_add],
  congr,
  apply finset_step_aux,
end

def sym2_eqv {n} : { p : fin n × fin n // p.1 ≤ p.2 } ≃ sym2 (fin n) :=
  {
    to_fun := λ p, ⟦p⟧,
    inv_fun := λ p, begin
      refine quot.lift _ _ p,
      rintro ⟨v₁, v₂⟩,
      by_cases h : v₁ ≤ v₂,
      exact ⟨(v₁, v₂), h⟩,
      exact ⟨(v₂, v₁), le_of_lt (lt_of_not_le h)⟩,
      rintros p₁ p₂ h,
      cases h, refl,
      cases (lt_trichotomy h_x h_y) with h₁ h₁,
      have h₂ := le_of_lt h₁,
      simp [h₁, h₂],
      cases h₁ with h₁,
      subst h₁,
      have h₂ := le_of_lt h₁,
      simp [h₁, h₂],
    end,
    left_inv := begin
      intro p,
      unfold quotient.mk,
      have h : (p : fin n × fin n) = p.val := rfl,
      rw [h], clear h,
      rcases p with ⟨⟨v₁, v₂⟩, h₁⟩,
      simp [h₁],
    end,
    right_inv := begin
      intro p,
      refine quot.ind _ p, clear p,
      rintro ⟨v₁, v₂⟩,
      by_cases h₁ : v₁ ≤ v₂,
      simp [h₁], refl,
      simp [h₁], change ⟦(v₂, v₁)⟧ = ⟦(v₁, v₂)⟧,
      simp only [quotient.eq, sym2.rel_iff, eq_self_iff_true, and_self, or_true],
    end
  }

def emb_sym2 {n} : { p : fin n × fin n // p.1 ≤ p.2 } ↪ sym2 (fin n) :=
  ⟨(λ p, ⟦p⟧), begin
    rintros ⟨⟨v₁, v₂⟩, h₁⟩ ⟨⟨v₃, v₄⟩, h₂⟩,
    simp only [subtype.coe_mk, quotient.eq, sym2.rel_iff, prod.mk.inj_iff],
    simp only at h₁ h₂,
    intro h₃,
    cases h₃,
    assumption,
    rcases h₃ with ⟨h₃, h₄⟩,
    subst h₃, subst h₄,
    have h₃ : v₁ = v₂ := ge_antisymm h₂ h₁,
    tauto,
  end⟩

lemma sym2_elems {n} : fintype.elems (sym2 (fin n)) =
  (fintype.elems ({ p : fin n × fin n // p.1 ≤ p.2 })).map emb_sym2 :=
begin
  ext p,
  simp [fintype.complete],
  have h : ∃ (v v' : fin n), p = ⟦(v, v')⟧ := sym2.exists.mp ⟨p, rfl⟩,
  rcases h with ⟨v, v', h⟩,
  by_cases h' : v ≤ v',
  use v, use v', tauto,
  use v', use v, have h'' : v' ≤ v := le_of_not_ge h',
  split, rw h, change ⟦(v', v)⟧ = ⟦(v, v')⟧,
  simp only [quotient.eq, sym2.rel_iff, eq_self_iff_true, and_self, or_true],
  assumption,
end

lemma finsum_sym2 {X n} [add_comm_monoid X] (f : sym2 (fin n) → X)
  : ∑ (p : sym2 (fin n)), f p = ∑ (p : { p : fin n × fin n // p.1 ≤ p.2 }), f ⟦p⟧ :=
begin
  change (fintype.elems _).sum f = (fintype.elems _).sum (f ∘ emb_sym2),
  rw sym2_elems,
  simp only [sum_map],
end

lemma finsum_aux₁ {X n} [add_comm_monoid X] (f : fin n × fin n → X)
  : ∑ (p : { p : fin n × fin n // p.1 ≤ p.2 }), f p =
    ∑ (v : fin n), ∑ (v' : fin n), ite (v ≤ v') (f (v, v')) 0 :=
begin
  dsimp [finset.sum],
  have h' : ∀ v v', ite (v ≤ v') (f (v, v')) 0 = multiset.sum (multiset.map f (multiset.map (λ v', (v, v')) (ite (v ≤ v') {v'} {}))) := by {
    intros v v',
    by_cases h : v ≤ v',
    simp [h], simp [h],
  },
  simp_rw [h'], clear h',
  simp_rw [←multiset.sum_bind],
  congr,
  nth_rewrite 0 [←multiset.map_map],
  simp_rw [←multiset.map_bind],
  congr, clear f,
  have h' : ∀ (v v' : fin n), ite (v ≤ v') {v'} {} = multiset.filter (λ v', v ≤ v') {v'} := by {
    intros v v',
    simp_rw [←multiset.filter_singleton],
  },
  simp_rw [h'], clear h',
  simp_rw [multiset.map_bind],
  ext p,
  rcases p with ⟨v₁, v₂⟩,

  simp_rw [multiset.count_bind],
  simp_rw [multiset.count_map],
  simp_rw [multiset.filter_filter],
  simp_rw [←multiset.countp_eq_card_filter],

  by_cases h : v₁ ≤ v₂,
  let p : { p : fin n × fin n // p.1 ≤ p.2 } := ⟨⟨v₁, v₂⟩, h⟩,
  have h₁ : ∀ p', p = p' ↔ (v₁, v₂) = ↑p' := by simp,
  simp_rw [←h₁], clear h₁,
  have h₃ : ∀ x, (λ a, (v₁, v₂) = (x, a) ∧ x ≤ a) = ite (x = v₁) (λ a, v₂ = a) (λ _, false) := by {
    intro x, ext a,
    split,
    rintro ⟨h₃, h₄⟩,
    cases h₃, simp,
    by_cases h₃ : x = v₁,
    simp [h₃, h], cc,
    simp [h₃],
  },
  simp_rw [h₃], clear h₃,
  have h₄ : ∀ v v', multiset.countp (ite (v = v₁) (eq v₂) (λ (_ : fin n), false)) {v'}
    = ite (v = v₁) (multiset.countp (eq v₂) {v'}) 0 :=
  begin
    intros v v',
    by_cases h₄ : v = v₁,
    simp [h₄],
    simp [h₄],
  end,
  simp_rw [h₄], clear h₄,
  change multiset.count p univ.val = _,
  simp,

  have h₁ : ∀ x, (multiset.map (λ (x_1 : fin n), ite (x = v₁) (multiset.countp (eq v₂) {x_1}) 0) univ.val).sum
    = ite (x = v₁) 1 0 :=
  begin
    intro x,
    split_ifs with h₂,
    change (multiset.map (λ (x_1 : fin n), multiset.count v₂ (x_1 ::ₘ {})) univ.val).sum = 1,
    simp_rw [←multiset.count_bind],
    simp, simp,
  end,

  simp_rw [h₁], clear h₁,
  have h₁ : ∀ x, (x = v₁) = (v₁ = x) := by { intro, ext, cc},
  simp_rw [h₁], clear h₁,
  simp_rw [←multiset.count_singleton],
  simp_rw [←multiset.count_bind],
  simp,

  have h₁ : ∀ (a : {p : fin n × fin n // p.fst ≤ p.snd}), (v₁, v₂) = a ↔ false := by {
    intro p, cases p, simp, intro h', cc,
  },

  simp_rw [h₁], clear h₁,
  simp,

  have h₁ : ∀ (x a : fin n), ((v₁ = x ∧ v₂ = a) ∧ x ≤ a) ↔ false := by {
    intros x a,
    simp, intros h₁ h₂,
    rw [←h₁, ←h₂], exact not_le.mp h,
  },

  simp_rw [h₁], clear h₁,
  simp,
end

lemma finsum_aux₂ {X n} [add_comm_monoid X] (f : fin n × fin n → X) (hf : ∀ x x', f (x, x') = f (x', x))
  : 2 • ∑ (v : fin n), ∑ (v' : fin n), ite (v ≤ v') (f (v, v')) 0
  = ∑ (v : fin n), ((∑ (v' : fin n), f (v, v')) + f (v, v)) :=
begin
  induction n,
  simp [finsum_zero],
  simp_rw [finsum_step],
  simp,
  specialize n_ih (λ p, f (p.1.cast_succ, p.2.cast_succ)) (by simp [hf]),
  simp at n_ih,
  simp_rw [finset.sum_add_distrib, smul_add],
  simp_rw [n_ih], clear n_ih,
  simp_rw [finset.sum_add_distrib],
  simp_rw [add_assoc],
  congr' 1, abel,
  congr' 1,
  nth_rewrite 0 [add_comm],
  nth_rewrite 0 [←add_assoc],
  congr' 1,
  have h₁ : ∀ (x : fin n_n), x.cast_succ ≤ fin.last n_n := by {
    intro,
    exact (fin.cast_succ x).le_last,
  },
  have h₂ : ∀ (x : fin n_n), ¬(fin.last n_n ≤ x.cast_succ) := by {
    intro,
    simp,
    apply fin.cast_succ_lt_last,
  },
  simp_rw [h₁, h₂],
  simp [hf],
  abel,
end

lemma finsum_aux₃ {X n} [add_comm_monoid X] (f : sym2 (fin n) → X)
 : ∑ (v : fin n), ((∑ (v' : fin n), f ⟦(v, v')⟧) + f ⟦(v, v)⟧) =
  2 • ∑ (p : sym2 (fin n)), f p :=
begin
  let f' := λ p, f ⟦p⟧,
  have hf : ∀ x x', f' (x, x') = f' (x', x) := by {
    intros x x',
    change f ⟦(x, x')⟧ = f ⟦(x', x)⟧,
    rw [sym2.eq_swap],
  },
  rw [finsum_sym2],
  change _ = 2 • ∑ (p : {p : fin n × fin n // p.fst ≤ p.snd}), f' p,
  rw [finsum_aux₁],
  rwa [finsum_aux₂],
end

lemma handshake' (V : Type u) (E : sym2 V → Type v) [fintype V]
  [∀ p, fintype (E p)] : ∑ᶠ (x : V), degree' V E x =
  ∑ᶠ (p : sym2 V), nat.card (E p) :=
begin

end

theorem handshake (G : graph V E) [fin_V : fintype V] [fin_E : fintype E] :
  ∑ (x : V), G.degree x = 2 * (fintype.card E) :=
begin
  sorry,
end


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Yakov Pechersky

! This file was ported from Lean 3 source module data.list.rotate
! leanprover-community/mathlib commit f694c7dead66f5d4c80f446c796a5aad14707f0e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.List.Perm
import Mathlib.Data.List.Range

/-!
# List rotation

This file proves basic results about `List.rotate`, the list rotation.

## Main declarations

* `List.IsRotated l₁ l₂`: States that `l₁` is a rotated version of `l₂`.
* `List.cyclicPermutations l`: The list of all cyclic permutants of `l`, up to the length of `l`.

## Tags

rotated, rotation, permutation, cycle
-/

universe u

variable {α : Type u}

open Nat Function

namespace List

theorem rotate_mod (l : List α) (n : ℕ) : l.rotate (n % l.length) = l.rotate n := by simp [rotate]
#align list.rotate_mod List.rotate_mod

@[simp]
theorem rotate_nil (n : ℕ) : ([] : List α).rotate n = [] := by simp [rotate]
#align list.rotate_nil List.rotate_nil

@[simp]
theorem rotate_zero (l : List α) : l.rotate 0 = l := by simp [rotate]
#align list.rotate_zero List.rotate_zero

--Porting note: removing simp, simp can prove it

@[simp]
theorem rotate'_zero (l : List α) : l.rotate' 0 = l := by cases l <;> rfl
#align list.rotate'_zero List.rotate'_zero

theorem rotate'_cons_succ (l : List α) (a : α) (n : ℕ) :
    (a :: l : List α).rotate' n.succ = (l ++ [a]).rotate' n := by simp [rotate']
#align list.rotate'_cons_succ List.rotate'_cons_succ

@[simp]
theorem length_rotate' : ∀ (l : List α) (n : ℕ), (l.rotate' n).length = l.length
  | [], _ => by simp
  | a :: l, 0 => rfl
  | a :: l, n + 1 => by rw [List.rotate', length_rotate' (l ++ [a]) n]; simp
#align list.length_rotate' List.length_rotate'

theorem rotate'_eq_drop_append_take :
    ∀ {l : List α} {n : ℕ}, n ≤ l.length → l.rotate' n = l.drop n ++ l.take n
  | [], n, h => by simp [drop_append_of_le_length h]
  | l, 0, h => by simp [take_append_of_le_length h]
  | a :: l, n + 1, h => by
    have hnl : n ≤ l.length := le_of_succ_le_succ h
    have hnl' : n ≤ (l ++ [a]).length := by
      rw [length_append, length_cons, List.length]; exact le_of_succ_le h
    rw [rotate'_cons_succ, rotate'_eq_drop_append_take hnl', drop, take,
        drop_append_of_le_length hnl, take_append_of_le_length hnl]; simp
#align list.rotate'_eq_drop_append_take List.rotate'_eq_drop_append_take

-- Porting note: Added termination_by and decreasing_by as recursion fails
theorem rotate'_rotate' : ∀ (l : List α) (n m : ℕ), (l.rotate' n).rotate' m = l.rotate' (n + m)
  | a :: l, 0, m => by simp
  | [], n, m => by simp
  | a :: l, n + 1, m => by
    rw [rotate'_cons_succ, rotate'_rotate' _ n, add_right_comm, ← rotate'_cons_succ]
    simp
  termination_by rotate'_rotate' l n _ => (l.length, n)
#align list.rotate'_rotate' List.rotate'_rotate'

@[simp]
theorem rotate'_length (l : List α) : rotate' l l.length = l := by
  rw [rotate'_eq_drop_append_take le_rfl]; simp
#align list.rotate'_length List.rotate'_length

-- Porting note: Added termination_by and decreasing_by as recursion fails
@[simp]
theorem rotate'_length_mul (l : List α) : ∀ n : ℕ, l.rotate' (l.length * n) = l
  | 0 => by simp
  | n + 1 =>
    calc
      l.rotate' (l.length * (n + 1)) =
          (l.rotate' (l.length * n)).rotate' (l.rotate' (l.length * n)).length :=
        by simp [-rotate'_length, Nat.mul_succ, rotate'_rotate']
      _ = l := by rw [rotate'_length, rotate'_length_mul l n]
#align list.rotate'_length_mul List.rotate'_length_mul

theorem rotate'_mod (l : List α) (n : ℕ) : l.rotate' (n % l.length) = l.rotate' n :=
  calc
    l.rotate' (n % l.length) =
        (l.rotate' (n % l.length)).rotate' ((l.rotate' (n % l.length)).length * (n / l.length)) :=
      by rw [rotate'_length_mul]
    _ = l.rotate' n := by rw [rotate'_rotate', length_rotate', Nat.mod_add_div]

#align list.rotate'_mod List.rotate'_mod

theorem rotate_eq_rotate' (l : List α) (n : ℕ) : l.rotate n = l.rotate' n :=
  if h : l.length = 0 then by simp_all [length_eq_zero]
  else by
    rw [← rotate'_mod,
        rotate'_eq_drop_append_take (le_of_lt (Nat.mod_lt _ (Nat.pos_of_ne_zero h)))];
      simp [rotate]
#align list.rotate_eq_rotate' List.rotate_eq_rotate'

theorem rotate_cons_succ (l : List α) (a : α) (n : ℕ) :
    (a :: l : List α).rotate n.succ = (l ++ [a]).rotate n := by
  rw [rotate_eq_rotate', rotate_eq_rotate', rotate'_cons_succ]
#align list.rotate_cons_succ List.rotate_cons_succ

@[simp]
theorem mem_rotate : ∀ {l : List α} {a : α} {n : ℕ}, a ∈ l.rotate n ↔ a ∈ l
  | [], _, n => by simp
  | a :: l, _, 0 => by simp
  | a :: l, _, n + 1 => by simp [rotate_cons_succ, mem_rotate, or_comm]
#align list.mem_rotate List.mem_rotate

@[simp]
theorem length_rotate (l : List α) (n : ℕ) : (l.rotate n).length = l.length := by
  rw [rotate_eq_rotate', length_rotate']
#align list.length_rotate List.length_rotate

-- porting note: todo: add `@[simp]`
theorem rotate_replicate (a : α) (n : ℕ) (k : ℕ) : (replicate n a).rotate k = replicate n a :=
  eq_replicate.2 ⟨by rw [length_rotate, length_replicate], fun b hb =>
    eq_of_mem_replicate <| mem_rotate.1 hb⟩
#align list.rotate_replicate List.rotate_replicate

theorem rotate_eq_drop_append_take {l : List α} {n : ℕ} :
    n ≤ l.length → l.rotate n = l.drop n ++ l.take n := by
  rw [rotate_eq_rotate']; exact rotate'_eq_drop_append_take
#align list.rotate_eq_drop_append_take List.rotate_eq_drop_append_take

theorem rotate_eq_drop_append_take_mod {l : List α} {n : ℕ} :
    l.rotate n = l.drop (n % l.length) ++ l.take (n % l.length) := by
  cases' l.length.zero_le.eq_or_lt with hl hl
  · simp [eq_nil_of_length_eq_zero hl.symm]
  rw [← rotate_eq_drop_append_take (n.mod_lt hl).le, rotate_mod]
#align list.rotate_eq_drop_append_take_mod List.rotate_eq_drop_append_take_mod

@[simp]
theorem rotate_append_length_eq (l l' : List α) : (l ++ l').rotate l.length = l' ++ l := by
  rw [rotate_eq_rotate']
  induction l generalizing l'
  · simp
  · simp_all [rotate']
#align list.rotate_append_length_eq List.rotate_append_length_eq

theorem rotate_rotate (l : List α) (n m : ℕ) : (l.rotate n).rotate m = l.rotate (n + m) := by
  rw [rotate_eq_rotate', rotate_eq_rotate', rotate_eq_rotate', rotate'_rotate']
#align list.rotate_rotate List.rotate_rotate

@[simp]
theorem rotate_length (l : List α) : rotate l l.length = l := by
  rw [rotate_eq_rotate', rotate'_length]
#align list.rotate_length List.rotate_length

@[simp]
theorem rotate_length_mul (l : List α) (n : ℕ) : l.rotate (l.length * n) = l := by
  rw [rotate_eq_rotate', rotate'_length_mul]
#align list.rotate_length_mul List.rotate_length_mul

theorem prod_rotate_eq_one_of_prod_eq_one [Group α] :
    ∀ {l : List α} (_ : l.prod = 1) (n : ℕ), (l.rotate n).prod = 1
  | [], _, _ => by simp
  | a :: l, hl, n =>
    by
    have : n % List.length (a :: l) ≤ List.length (a :: l) := le_of_lt (Nat.mod_lt _ (by simp))
    rw [← List.take_append_drop (n % List.length (a :: l)) (a :: l)] at hl;
      rw [← rotate_mod, rotate_eq_drop_append_take this, List.prod_append, mul_eq_one_iff_inv_eq, ←
        one_mul (List.prod _)⁻¹, ← hl, List.prod_append, mul_assoc, mul_inv_self, mul_one]
#align list.prod_rotate_eq_one_of_prod_eq_one List.prod_rotate_eq_one_of_prod_eq_one

theorem rotate_perm (l : List α) (n : ℕ) : l.rotate n ~ l := by
  rw [rotate_eq_rotate']
  induction' n with n hn generalizing l
  · simp
  · cases' l with hd tl
    · simp
    · rw [rotate'_cons_succ]
      exact (hn _).trans (perm_append_singleton _ _)
#align list.rotate_perm List.rotate_perm

@[simp]
theorem nodup_rotate {l : List α} {n : ℕ} : Nodup (l.rotate n) ↔ Nodup l :=
  (rotate_perm l n).nodup_iff
#align list.nodup_rotate List.nodup_rotate

@[simp]
theorem rotate_eq_nil_iff {l : List α} {n : ℕ} : l.rotate n = [] ↔ l = [] := by
  induction' n with n hn generalizing l
  · simp
  · cases' l with hd tl
    · simp
    · simp [rotate_cons_succ, hn]
#align list.rotate_eq_nil_iff List.rotate_eq_nil_iff

@[simp]
theorem nil_eq_rotate_iff {l : List α} {n : ℕ} : [] = l.rotate n ↔ [] = l := by
  rw [eq_comm, rotate_eq_nil_iff, eq_comm]
#align list.nil_eq_rotate_iff List.nil_eq_rotate_iff

@[simp]
theorem rotate_singleton (x : α) (n : ℕ) : [x].rotate n = [x] :=
  rotate_replicate x 1 n
#align list.rotate_singleton List.rotate_singleton

theorem zipWith_rotate_distrib {α β γ : Type _} (f : α → β → γ) (l : List α) (l' : List β) (n : ℕ)
    (h : l.length = l'.length) : (zipWith f l l').rotate n = zipWith f (l.rotate n) (l'.rotate n) :=
  by
  rw [rotate_eq_drop_append_take_mod, rotate_eq_drop_append_take_mod,
    rotate_eq_drop_append_take_mod, h, zipWith_append, ← zipWith_distrib_drop, ←
    zipWith_distrib_take, List.length_zipWith, h, min_self]
  rw [length_drop, length_drop, h]
#align list.zip_with_rotate_distrib List.zipWith_rotate_distrib

attribute [local simp] rotate_cons_succ

--Porting note: removing @[simp], simp can prove it
theorem zipWith_rotate_one {β : Type _} (f : α → α → β) (x y : α) (l : List α) :
    zipWith f (x :: y :: l) ((x :: y :: l).rotate 1) = f x y :: zipWith f (y :: l) (l ++ [x]) := by
  simp
#align list.zip_with_rotate_one List.zipWith_rotate_one

theorem get?_rotate {l : List α} {n m : ℕ} (hml : m < l.length) :
    (l.rotate n).get? m = l.get? ((m + n) % l.length) := by
  rw [rotate_eq_drop_append_take_mod]
  rcases lt_or_le m (l.drop (n % l.length)).length with hm | hm
  · rw [get?_append hm, get?_drop, add_comm m, ← mod_add_mod]
    rw [length_drop, lt_tsub_iff_left] at hm
    rw [mod_eq_of_lt hm]
  · have hlt : n % length l < length l := mod_lt _ (m.zero_le.trans_lt hml)
    rw [get?_append_right hm, get?_take, length_drop]
    · congr 1
      rw [length_drop] at hm
      have hm' := tsub_le_iff_left.1 hm
      have : n % length l + m - length l < length l
      · rw [tsub_lt_iff_left hm']
        exact Nat.add_lt_add hlt hml
      conv_rhs => rw [add_comm m, ← mod_add_mod, mod_eq_sub_mod hm', mod_eq_of_lt this]
      rw [← add_right_inj l.length, ← add_tsub_assoc_of_le, add_tsub_tsub_cancel,
        add_tsub_cancel_of_le, add_comm]
      exacts [hm', hlt.le, hm]
    · rwa [tsub_lt_iff_left hm, length_drop, tsub_add_cancel_of_le hlt.le]
#align list.nth_rotate List.get?_rotate

-- porting note: new lemma
theorem get_rotate (l : List α) (n : ℕ) (k : Fin (l.rotate n).length) :
    (l.rotate n).get k =
      l.get ⟨(k + n) % l.length, mod_lt _ (length_rotate l n ▸ k.1.zero_le.trans_lt k.2)⟩ := by
  rw [← Option.some_inj, ← get?_eq_get, ← get?_eq_get, get?_rotate]
  exact k.2.trans_eq (length_rotate _ _)

theorem head?_rotate {l : List α} {n : ℕ} (h : n < l.length) : head? (l.rotate n) = l.get? n := by
  rw [← get?_zero, get?_rotate (n.zero_le.trans_lt h), zero_add, Nat.mod_eq_of_lt h]
#align list.head'_rotate List.head?_rotate

-- porting note: moved down from its original location below `get_rotate` so that the
-- non-deprecated lemma does not use the deprecated version
set_option linter.deprecated false in
@[deprecated get_rotate]
theorem nthLe_rotate (l : List α) (n k : ℕ) (hk : k < (l.rotate n).length) :
    (l.rotate n).nthLe k hk =
      l.nthLe ((k + n) % l.length) (mod_lt _ (length_rotate l n ▸ k.zero_le.trans_lt hk)) :=
  get_rotate l n ⟨k, hk⟩
#align list.nth_le_rotate List.nthLe_rotate

set_option linter.deprecated false in
theorem nthLe_rotate_one (l : List α) (k : ℕ) (hk : k < (l.rotate 1).length) :
    (l.rotate 1).nthLe k hk =
      l.nthLe ((k + 1) % l.length) (mod_lt _ (length_rotate l 1 ▸ k.zero_le.trans_lt hk)) :=
  nthLe_rotate l 1 k hk
#align list.nth_le_rotate_one List.nthLe_rotate_one

-- porting note: new lemma
/-- A version of `List.get_rotate` that represents `List.get l` in terms of
`List.get (List.rotate l n)`, not vice versa. Can be used instead of rewriting `List.get_rotate`
from right to left. -/
theorem get_eq_get_rotate (l : List α) (n : ℕ) (k : Fin l.length) :
    l.get k = (l.rotate n).get ⟨(l.length - n % l.length + k) % l.length,
      (Nat.mod_lt _ (k.1.zero_le.trans_lt k.2)).trans_eq (length_rotate _ _).symm⟩ := by
  rw [get_rotate]
  refine congr_arg l.get (Fin.eq_of_val_eq ?_)
  simp only [mod_add_mod]
  rw [← add_mod_mod, add_right_comm, tsub_add_cancel_of_le, add_mod_left, mod_eq_of_lt]
  exacts [k.2, (mod_lt _ (k.1.zero_le.trans_lt k.2)).le]

set_option linter.deprecated false in
/-- A variant of `List.nthLe_rotate` useful for rewrites from right to left. -/
@[deprecated get_eq_get_rotate]
theorem nthLe_rotate' (l : List α) (n k : ℕ) (hk : k < l.length) :
    (l.rotate n).nthLe ((l.length - n % l.length + k) % l.length)
        ((Nat.mod_lt _ (k.zero_le.trans_lt hk)).trans_le (length_rotate _ _).ge) =
      l.nthLe k hk :=
  (get_eq_get_rotate l n ⟨k, hk⟩).symm
#align list.nth_le_rotate' List.nthLe_rotate'

theorem rotate_eq_self_iff_eq_replicate [hα : Nonempty α] :
    ∀ {l : List α}, (∀ n, l.rotate n = l) ↔ ∃ a, l = replicate l.length a
  | [] => by simp
  | a :: l => ⟨fun h => ⟨a, ext_get (length_replicate _ _).symm fun n h₁ h₂ => by
      rw [get_replicate, ← Option.some_inj, ← get?_eq_get, ← head?_rotate h₁, h, head?_cons]⟩,
    fun ⟨b, hb⟩ n => by rw [hb, rotate_replicate]⟩
#align list.rotate_eq_self_iff_eq_replicate List.rotate_eq_self_iff_eq_replicate

theorem rotate_one_eq_self_iff_eq_replicate [Nonempty α] {l : List α} :
    l.rotate 1 = l ↔ ∃ a : α, l = List.replicate l.length a :=
  ⟨fun h =>
    rotate_eq_self_iff_eq_replicate.mp fun n =>
      Nat.rec l.rotate_zero (fun n hn => by rwa [Nat.succ_eq_add_one, ← l.rotate_rotate, hn]) n,
    fun h => rotate_eq_self_iff_eq_replicate.mpr h 1⟩
#align list.rotate_one_eq_self_iff_eq_replicate List.rotate_one_eq_self_iff_eq_replicate

theorem rotate_injective (n : ℕ) : Function.Injective fun l : List α => l.rotate n := by
  rintro l l' (h : l.rotate n = l'.rotate n)
  have hle : l.length = l'.length := (l.length_rotate n).symm.trans (h.symm ▸ l'.length_rotate n)
  rw [rotate_eq_drop_append_take_mod, rotate_eq_drop_append_take_mod] at h
  obtain ⟨hd, ht⟩ := append_inj h (by simp_all)
  rw [← take_append_drop _ l, ht, hd, take_append_drop]
#align list.rotate_injective List.rotate_injective

@[simp]
theorem rotate_eq_rotate {l l' : List α} {n : ℕ} : l.rotate n = l'.rotate n ↔ l = l' :=
  (rotate_injective n).eq_iff
#align list.rotate_eq_rotate List.rotate_eq_rotate

theorem rotate_eq_iff {l l' : List α} {n : ℕ} :
    l.rotate n = l' ↔ l = l'.rotate (l'.length - n % l'.length) := by
  rw [← @rotate_eq_rotate _ l _ n, rotate_rotate, ← rotate_mod l', add_mod]
  cases' l'.length.zero_le.eq_or_lt with hl hl
  · rw [eq_nil_of_length_eq_zero hl.symm, rotate_nil, rotate_eq_nil_iff]
  · cases' (Nat.zero_le (n % l'.length)).eq_or_lt with hn hn
    · simp [← hn]
    · rw [mod_eq_of_lt (tsub_lt_self hl hn), tsub_add_cancel_of_le, mod_self, rotate_zero]
      exact (Nat.mod_lt _ hl).le
#align list.rotate_eq_iff List.rotate_eq_iff

@[simp]
theorem rotate_eq_singleton_iff {l : List α} {n : ℕ} {x : α} : l.rotate n = [x] ↔ l = [x] := by
  rw [rotate_eq_iff, rotate_singleton]
#align list.rotate_eq_singleton_iff List.rotate_eq_singleton_iff

@[simp]
theorem singleton_eq_rotate_iff {l : List α} {n : ℕ} {x : α} : [x] = l.rotate n ↔ [x] = l := by
  rw [eq_comm, rotate_eq_singleton_iff, eq_comm]
#align list.singleton_eq_rotate_iff List.singleton_eq_rotate_iff

theorem reverse_rotate (l : List α) (n : ℕ) :
    (l.rotate n).reverse = l.reverse.rotate (l.length - n % l.length) := by
  rw [← length_reverse l, ← rotate_eq_iff]
  induction' n with n hn generalizing l
  · simp
  · cases' l with hd tl
    · simp
    · rw [rotate_cons_succ, Nat.succ_eq_add_one, ← rotate_rotate, hn]
      simp
#align list.reverse_rotate List.reverse_rotate

theorem rotate_reverse (l : List α) (n : ℕ) :
    l.reverse.rotate n = (l.rotate (l.length - n % l.length)).reverse := by
  rw [← reverse_reverse l]
  simp_rw [reverse_rotate, reverse_reverse, rotate_eq_iff, rotate_rotate, length_rotate,
    length_reverse]
  rw [← length_reverse l]
  let k := n % l.reverse.length
  cases' hk' : k with k'
  · simp_all! [length_reverse, ← rotate_rotate]
  · cases' l with x l
    · simp
    · rw [Nat.mod_eq_of_lt, tsub_add_cancel_of_le, rotate_length]
      · exact tsub_le_self
      · exact tsub_lt_self (by simp) (by simp_all!)
#align list.rotate_reverse List.rotate_reverse

theorem map_rotate {β : Type _} (f : α → β) (l : List α) (n : ℕ) :
    map f (l.rotate n) = (map f l).rotate n := by
  induction' n with n hn IH generalizing l
  · simp
  · cases' l with hd tl
    · simp
    · simp [hn]
#align list.map_rotate List.map_rotate

set_option linter.deprecated false in
theorem Nodup.rotate_eq_self_iff {l : List α} (hl : l.Nodup) {n : ℕ} :
    l.rotate n = l ↔ n % l.length = 0 ∨ l = [] := by
  constructor
  · intro h
    cases' l.length.zero_le.eq_or_lt with hl' hl'
    · simp [← length_eq_zero, ← hl']
    left
    rw [nodup_iff_nthLe_inj] at hl
    refine' hl _ _ (mod_lt _ hl') hl' _
    rw [← nthLe_rotate' _ n]
    simp_rw [h, tsub_add_cancel_of_le (mod_lt _ hl').le, mod_self]
  · rintro (h | h)
    · rw [← rotate_mod, h]
      exact rotate_zero l
    · simp [h]
#align list.nodup.rotate_eq_self_iff List.Nodup.rotate_eq_self_iff

set_option linter.deprecated false in
theorem Nodup.rotate_congr {l : List α} (hl : l.Nodup) (hn : l ≠ []) (i j : ℕ)
    (h : l.rotate i = l.rotate j) : i % l.length = j % l.length := by
  have hi : i % l.length < l.length := mod_lt _ (length_pos_of_ne_nil hn)
  have hj : j % l.length < l.length := mod_lt _ (length_pos_of_ne_nil hn)
  refine' (nodup_iff_nthLe_inj.mp hl) _ _ hi hj _
  rw [← nthLe_rotate' l i, ← nthLe_rotate' l j]
  simp [tsub_add_cancel_of_le, hi.le, hj.le, h]
#align list.nodup.rotate_congr List.Nodup.rotate_congr

section IsRotated

variable (l l' : List α)

/-- `IsRotated l₁ l₂` or `l₁ ~r l₂` asserts that `l₁` and `l₂` are cyclic permutations
  of each other. This is defined by claiming that `∃ n, l.rotate n = l'`. -/
def IsRotated : Prop :=
  ∃ n, l.rotate n = l'
#align list.is_rotated List.IsRotated

@[inherit_doc List.IsRotated]
infixr:1000 " ~r " => IsRotated

variable {l l'}

@[refl]
theorem IsRotated.refl (l : List α) : l ~r l :=
  ⟨0, by simp⟩
#align list.is_rotated.refl List.IsRotated.refl

@[symm]
theorem IsRotated.symm (h : l ~r l') : l' ~r l := by
  obtain ⟨n, rfl⟩ := h
  cases' l with hd tl
  · exists 0
  · use (hd :: tl).length * n - n
    rw [rotate_rotate, add_tsub_cancel_of_le, rotate_length_mul]
    exact Nat.le_mul_of_pos_left (by simp)
#align list.is_rotated.symm List.IsRotated.symm

theorem isRotated_comm : l ~r l' ↔ l' ~r l :=
  ⟨IsRotated.symm, IsRotated.symm⟩
#align list.is_rotated_comm List.isRotated_comm

@[simp]
protected theorem IsRotated.forall (l : List α) (n : ℕ) : l.rotate n ~r l :=
  IsRotated.symm ⟨n, rfl⟩
#align list.is_rotated.forall List.IsRotated.forall

@[trans]
theorem IsRotated.trans : ∀ {l l' l'' : List α}, l ~r l' → l' ~r l'' → l ~r l''
  | _, _, _, ⟨n, rfl⟩, ⟨m, rfl⟩ => ⟨n + m, by rw [rotate_rotate]⟩
#align list.is_rotated.trans List.IsRotated.trans

theorem IsRotated.eqv : Equivalence (@IsRotated α) :=
  Equivalence.mk IsRotated.refl IsRotated.symm IsRotated.trans
#align list.is_rotated.eqv List.IsRotated.eqv

/-- The relation `List.IsRotated l l'` forms a `Setoid` of cycles. -/
def IsRotated.setoid (α : Type _) : Setoid (List α) where
  r := IsRotated
  iseqv := IsRotated.eqv
#align list.is_rotated.setoid List.IsRotated.setoid

theorem IsRotated.perm (h : l ~r l') : l ~ l' :=
  Exists.elim h fun _ hl => hl ▸ (rotate_perm _ _).symm
#align list.is_rotated.perm List.IsRotated.perm

theorem IsRotated.nodup_iff (h : l ~r l') : Nodup l ↔ Nodup l' :=
  h.perm.nodup_iff
#align list.is_rotated.nodup_iff List.IsRotated.nodup_iff

theorem IsRotated.mem_iff (h : l ~r l') {a : α} : a ∈ l ↔ a ∈ l' :=
  h.perm.mem_iff
#align list.is_rotated.mem_iff List.IsRotated.mem_iff

@[simp]
theorem isRotated_nil_iff : l ~r [] ↔ l = [] :=
  ⟨fun ⟨n, hn⟩ => by simpa using hn, fun h => h ▸ by rfl⟩
#align list.is_rotated_nil_iff List.isRotated_nil_iff

@[simp]
theorem isRotated_nil_iff' : [] ~r l ↔ [] = l := by
  rw [isRotated_comm, isRotated_nil_iff, eq_comm]
#align list.is_rotated_nil_iff' List.isRotated_nil_iff'

@[simp]
theorem isRotated_singleton_iff {x : α} : l ~r [x] ↔ l = [x] :=
  ⟨fun ⟨n, hn⟩ => by simpa using hn, fun h => h ▸ by rfl⟩
#align list.is_rotated_singleton_iff List.isRotated_singleton_iff

@[simp]
theorem isRotated_singleton_iff' {x : α} : [x] ~r l ↔ [x] = l := by
  rw [isRotated_comm, isRotated_singleton_iff, eq_comm]
#align list.is_rotated_singleton_iff' List.isRotated_singleton_iff'

theorem isRotated_concat (hd : α) (tl : List α) : (tl ++ [hd]) ~r (hd :: tl) :=
  IsRotated.symm ⟨1, by simp⟩
#align list.is_rotated_concat List.isRotated_concat

theorem isRotated_append : (l ++ l') ~r (l' ++ l) :=
  ⟨l.length, by simp⟩
#align list.is_rotated_append List.isRotated_append

theorem IsRotated.reverse (h : l ~r l') : l.reverse ~r l'.reverse := by
  obtain ⟨n, rfl⟩ := h
  exact ⟨_, (reverse_rotate _ _).symm⟩
#align list.is_rotated.reverse List.IsRotated.reverse

theorem isRotated_reverse_comm_iff : l.reverse ~r l' ↔ l ~r l'.reverse := by
  constructor <;>
    · intro h
      simpa using h.reverse
#align list.is_rotated_reverse_comm_iff List.isRotated_reverse_comm_iff

@[simp]
theorem isRotated_reverse_iff : l.reverse ~r l'.reverse ↔ l ~r l' := by
  simp [isRotated_reverse_comm_iff]
#align list.is_rotated_reverse_iff List.isRotated_reverse_iff

theorem isRotated_iff_mod : l ~r l' ↔ ∃ n ≤ l.length, l.rotate n = l' := by
  refine' ⟨fun h => _, fun ⟨n, _, h⟩ => ⟨n, h⟩⟩
  obtain ⟨n, rfl⟩ := h
  cases' l with hd tl
  · simp
  · refine' ⟨n % (hd :: tl).length, _, rotate_mod _ _⟩
    refine' (Nat.mod_lt _ _).le
    simp
#align list.is_rotated_iff_mod List.isRotated_iff_mod

theorem isRotated_iff_mem_map_range : l ~r l' ↔ l' ∈ (List.range (l.length + 1)).map l.rotate := by
  simp_rw [mem_map, mem_range, isRotated_iff_mod]
  exact
    ⟨fun ⟨n, hn, h⟩ => ⟨n, Nat.lt_succ_of_le hn, h⟩,
      fun ⟨n, hn, h⟩ => ⟨n, Nat.le_of_lt_succ hn, h⟩⟩
#align list.is_rotated_iff_mem_map_range List.isRotated_iff_mem_map_range

-- Porting note: @[congr] only works for equality.
-- @[congr]
theorem IsRotated.map {β : Type _} {l₁ l₂ : List α} (h : l₁ ~r l₂) (f : α → β) :
    map f l₁ ~r map f l₂ := by
  obtain ⟨n, rfl⟩ := h
  rw [map_rotate]
  use n
#align list.is_rotated.map List.IsRotated.map

/-- List of all cyclic permutations of `l`.
The `cyclicPermutations` of a nonempty list `l` will always contain `List.length l` elements.
This implies that under certain conditions, there are duplicates in `List.cyclicPermutations l`.
The `n`th entry is equal to `l.rotate n`, proven in `List.nthLe_cyclicPermutations`.
The proof that every cyclic permutant of `l` is in the list is `List.mem_cyclicPermutations_iff`.

     cyclicPermutations [1, 2, 3, 2, 4] =
       [[1, 2, 3, 2, 4], [2, 3, 2, 4, 1], [3, 2, 4, 1, 2],
        [2, 4, 1, 2, 3], [4, 1, 2, 3, 2]] -/
def cyclicPermutations : List α → List (List α)
  | [] => [[]]
  | l@(_ :: _) => dropLast (zipWith (· ++ ·) (tails l) (inits l))
#align list.cyclic_permutations List.cyclicPermutations

@[simp]
theorem cyclicPermutations_nil : cyclicPermutations ([] : List α) = [[]] :=
  rfl
#align list.cyclic_permutations_nil List.cyclicPermutations_nil

theorem cyclicPermutations_cons (x : α) (l : List α) :
    cyclicPermutations (x :: l) = dropLast (zipWith (· ++ ·) (tails (x :: l)) (inits (x :: l))) :=
  rfl
#align list.cyclic_permutations_cons List.cyclicPermutations_cons

theorem cyclicPermutations_of_ne_nil (l : List α) (h : l ≠ []) :
    cyclicPermutations l = dropLast (zipWith (· ++ ·) (tails l) (inits l)) := by
  obtain ⟨hd, tl, rfl⟩ := exists_cons_of_ne_nil h
  exact cyclicPermutations_cons _ _
#align list.cyclic_permutations_of_ne_nil List.cyclicPermutations_of_ne_nil

theorem length_cyclicPermutations_cons (x : α) (l : List α) :
    length (cyclicPermutations (x :: l)) = length l + 1 := by simp [cyclicPermutations_cons]
#align list.length_cyclic_permutations_cons List.length_cyclicPermutations_cons

@[simp]
theorem length_cyclicPermutations_of_ne_nil (l : List α) (h : l ≠ []) :
    length (cyclicPermutations l) = length l := by simp [cyclicPermutations_of_ne_nil _ h]
#align list.length_cyclic_permutations_of_ne_nil List.length_cyclicPermutations_of_ne_nil

set_option linter.deprecated false in
@[simp]
theorem nthLe_cyclicPermutations (l : List α) (n : ℕ) (hn : n < length (cyclicPermutations l)) :
    nthLe (cyclicPermutations l) n hn = l.rotate n := by
  obtain rfl | h := eq_or_ne l []
  · simp
  · rw [length_cyclicPermutations_of_ne_nil _ h] at hn
    simp [dropLast_eq_take, cyclicPermutations_of_ne_nil _ h, nthLe_take',
      rotate_eq_drop_append_take hn.le]
#align list.nth_le_cyclic_permutations List.nthLe_cyclicPermutations

set_option linter.deprecated false in
theorem mem_cyclicPermutations_self (l : List α) : l ∈ cyclicPermutations l := by
  cases' l with x l
  · simp
  · rw [mem_iff_nthLe]
    refine' ⟨0, by simp, _⟩
    simp
#align list.mem_cyclic_permutations_self List.mem_cyclicPermutations_self

set_option linter.deprecated false in
theorem length_mem_cyclicPermutations (l : List α) (h : l' ∈ cyclicPermutations l) :
    length l' = length l := by
  obtain ⟨k, hk, rfl⟩ := nthLe_of_mem h
  simp
#align list.length_mem_cyclic_permutations List.length_mem_cyclicPermutations

set_option linter.deprecated false in
@[simp]
theorem mem_cyclicPermutations_iff {l l' : List α} : l ∈ cyclicPermutations l' ↔ l ~r l' := by
  constructor
  · intro h
    obtain ⟨k, hk, rfl⟩ := nthLe_of_mem h
    simp
  · intro h
    obtain ⟨k, rfl⟩ := h.symm
    rw [mem_iff_nthLe]
    simp only [exists_prop, nthLe_cyclicPermutations]
    cases' l' with x l
    · simp
    · refine' ⟨k % length (x :: l), _, rotate_mod _ _⟩
      simpa using Nat.mod_lt _ (zero_lt_succ _)
#align list.mem_cyclic_permutations_iff List.mem_cyclicPermutations_iff

@[simp]
theorem cyclicPermutations_eq_nil_iff {l : List α} : cyclicPermutations l = [[]] ↔ l = [] := by
  refine' ⟨fun h => _, fun h => by simp [h]⟩
  rw [eq_comm, ← isRotated_nil_iff', ← mem_cyclicPermutations_iff, h, mem_singleton]
#align list.cyclic_permutations_eq_nil_iff List.cyclicPermutations_eq_nil_iff

@[simp]
theorem cyclicPermutations_eq_singleton_iff {l : List α} {x : α} :
    cyclicPermutations l = [[x]] ↔ l = [x] := by
  refine' ⟨fun h => _, fun h => by simp [cyclicPermutations, h, dropLast_eq_take]⟩
  rw [eq_comm, ← isRotated_singleton_iff', ← mem_cyclicPermutations_iff, h, mem_singleton]
#align list.cyclic_permutations_eq_singleton_iff List.cyclicPermutations_eq_singleton_iff

set_option linter.deprecated false in
/-- If a `l : List α` is `Nodup l`, then all of its cyclic permutants are distinct. -/
theorem Nodup.cyclicPermutations {l : List α} (hn : Nodup l) : Nodup (cyclicPermutations l) := by
  cases' l with x l
  · simp
  rw [nodup_iff_nthLe_inj]
  intro i j hi hj h
  simp only [length_cyclicPermutations_cons] at hi hj
  rw [← mod_eq_of_lt hi, ← mod_eq_of_lt hj]
  apply hn.rotate_congr
  · simp
  · simpa using h
#align list.nodup.cyclic_permutations List.Nodup.cyclicPermutations

set_option linter.deprecated false in
@[simp]
theorem cyclicPermutations_rotate (l : List α) (k : ℕ) :
    (l.rotate k).cyclicPermutations = l.cyclicPermutations.rotate k := by
  have : (l.rotate k).cyclicPermutations.length = length (l.cyclicPermutations.rotate k) := by
    cases l
    · simp
    · rw [length_cyclicPermutations_of_ne_nil] <;> simp
  refine' ext_nthLe this fun n hn hn' => _
  rw [nthLe_rotate, nthLe_cyclicPermutations, rotate_rotate, ← rotate_mod, add_comm]
  cases l <;> simp
#align list.cyclic_permutations_rotate List.cyclicPermutations_rotate

theorem IsRotated.cyclicPermutations {l l' : List α} (h : l ~r l') :
    l.cyclicPermutations ~r l'.cyclicPermutations := by
  obtain ⟨k, rfl⟩ := h
  exact ⟨k, by simp⟩
#align list.is_rotated.cyclic_permutations List.IsRotated.cyclicPermutations

set_option linter.deprecated false in
@[simp]
theorem isRotated_cyclicPermutations_iff {l l' : List α} :
    l.cyclicPermutations ~r l'.cyclicPermutations ↔ l ~r l' := by
  by_cases hl : l = []
  · simp [hl, eq_comm]
  have hl' : l.cyclicPermutations.length = l.length := length_cyclicPermutations_of_ne_nil _ hl
  refine' ⟨fun h => _, IsRotated.cyclicPermutations⟩
  obtain ⟨k, hk⟩ := h
  refine' ⟨k % l.length, _⟩
  have hk' : k % l.length < l.length := mod_lt _ (length_pos_of_ne_nil hl)
  rw [← nthLe_cyclicPermutations _ _ (hk'.trans_le hl'.ge), ← nthLe_rotate' _ k]
  simp [hk, hl', tsub_add_cancel_of_le hk'.le]
#align list.is_rotated_cyclic_permutations_iff List.isRotated_cyclicPermutations_iff

section Decidable

variable [DecidableEq α]

instance isRotatedDecidable (l l' : List α) : Decidable (l ~r l') :=
  decidable_of_iff' _ isRotated_iff_mem_map_range
#align list.is_rotated_decidable List.isRotatedDecidable

instance {l l' : List α} : Decidable (@Setoid.r _ (IsRotated.setoid α) l l') :=
  List.isRotatedDecidable _ _

end Decidable

end IsRotated

end List


/-
Copyright (c) 2019 Patrick MAssot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/
import topology.uniform_space.absolute_value
import topology.instances.real
import topology.uniform_space.completion

/-!
# Comparison of Cauchy reals and Bourbaki reals

In `data.real.basic` real numbers are defined using the so called Cauchy construction (although
it is due to Georg Cantor). More precisely, this construction applies to commutative rings equipped
with an absolute value with values in a linear ordered field.

On the other hand, in the `uniform_space` folder, we construct completions of general uniform
spaces, which allows to construct the Bourbaki real numbers. In this file we build uniformly
continuous bijections from Cauchy reals to Bourbaki reals and back. This is a cross sanity check of
both constructions. Of course those two constructions are variations on the completion idea, simply
with different level of generality. Comparing with Dedekind cuts or quasi-morphisms would be of a
completely different nature.

Note that `metric_space/cau_seq_filter` also relates the notions of Cauchy sequences in metric
spaces and Cauchy filters in general uniform spaces, and `metric_space/completion` makes sure
the completion (as a uniform space) of a metric space is a metric space.

Historical note: mathlib used to define real numbers in an intermediate way, using completion
of uniform spaces but extending multiplication in an ad-hoc way.

TODO:
* Upgrade this isomorphism to a topological ring isomorphism.
* Do the same comparison for p-adic numbers

## Implementation notes

The heavy work is done in `topology/uniform_space/abstract_completion` which provides an abstract
caracterization of completions of uniform spaces, and isomorphisms between them. The only work left
here is to prove the uniform space structure coming from the absolute value on ℚ (with values in ℚ,
not referring to ℝ) coincides with the one coming from the metric space structure (which of course
does use ℝ).

## References

* [N. Bourbaki, *Topologie générale*][bourbaki1966]

## Tags

real numbers, completion, uniform spaces
-/

open set function filter cau_seq uniform_space

/-- The metric space uniform structure on ℚ (which presupposes the existence
of real numbers) agrees with the one coming directly from (abs : ℚ → ℚ). -/
lemma rat.uniform_space_eq :
  is_absolute_value.uniform_space (abs : ℚ → ℚ) = metric_space.to_uniform_space' :=
begin
  ext s,
  erw [metric.mem_uniformity_dist, is_absolute_value.mem_uniformity],
  split ; rintro ⟨ε, ε_pos, h⟩,
  { use [ε, by exact_mod_cast ε_pos],
    intros a b hab,
    apply h,
    rw [rat.dist_eq, abs_sub] at hab,
    exact_mod_cast hab },
  { obtain ⟨ε', h', h''⟩ : ∃ ε' : ℚ, 0 < ε' ∧ (ε' : ℝ) < ε, from exists_pos_rat_lt ε_pos,
    use [ε', h'],
    intros a b hab,
    apply h,
    rw [rat.dist_eq, abs_sub],
    refine lt_trans _ h'',
    exact_mod_cast hab }
end

/-- Cauchy reals packaged as a completion of ℚ using the absolute value route. -/
noncomputable
def rational_cau_seq_pkg : @abstract_completion ℚ $ is_absolute_value.uniform_space (abs : ℚ → ℚ) :=
{ space := ℝ,
  coe := (coe : ℚ → ℝ),
  uniform_struct := by apply_instance,
  complete :=  by apply_instance,
  separation :=  by apply_instance,
  uniform_inducing := by { rw rat.uniform_space_eq,
                           exact uniform_embedding_of_rat.to_uniform_inducing },
  dense := dense_embedding_of_rat.dense }

namespace compare_reals
/-- Type wrapper around ℚ to make sure the absolute value uniform space instance is picked up
instead of the metric space one. We proved in rat.uniform_space_eq that they are equal,
but they are not definitionaly equal, so it would confuse the type class system (and probably
also human readers). -/
@[derive comm_ring, derive inhabited] def Q := ℚ

instance : uniform_space Q := is_absolute_value.uniform_space (abs : ℚ → ℚ)

/-- Real numbers constructed as in Bourbaki. -/
@[derive inhabited]
def Bourbakiℝ : Type := completion Q

instance bourbaki.uniform_space: uniform_space Bourbakiℝ := completion.uniform_space Q

/-- Bourbaki reals packaged as a completion of Q using the general theory. -/
def Bourbaki_pkg : abstract_completion Q := completion.cpkg

/-- The equivalence between Bourbaki and Cauchy reals-/
noncomputable def compare_equiv : Bourbakiℝ ≃ ℝ :=
Bourbaki_pkg.compare_equiv rational_cau_seq_pkg

lemma compare_uc : uniform_continuous (compare_equiv) :=
Bourbaki_pkg.uniform_continuous_compare_equiv _

lemma compare_uc_symm : uniform_continuous (compare_equiv).symm :=
Bourbaki_pkg.uniform_continuous_compare_equiv_symm _
end compare_reals


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
prelude
import init.relation init.tactic init.nat init.prod

inductive acc {A : Type} (R : A → A → Prop) : A → Prop :=
intro : ∀x, (∀ y, R y x → acc R y) → acc R x

namespace acc
  variables {A : Type} {R : A → A → Prop}

  definition inv {x y : A} (H₁ : acc R x) (H₂ : R y x) : acc R y :=
  acc.rec_on H₁ (λ x₁ ac₁ iH H₂, ac₁ y H₂) H₂

  -- dependent elimination for acc
  protected definition drec [recursor]
      {C : Π (a : A), acc R a → Type}
      (h₁ : Π (x : A) (acx : Π (y : A), R y x → acc R y),
              (Π (y : A) (ryx : R y x), C y (acx y ryx)) → C x (acc.intro x acx))
      {a : A} (h₂ : acc R a) : C a h₂ :=
  begin
    refine acc.rec _ h₂ h₂,
    intro x acx ih h₂,
    exact h₁ x acx (λ y ryx, ih y ryx (acx y ryx))
  end
end acc

inductive well_founded [class] {A : Type} (R : A → A → Prop) : Prop :=
intro : (∀ a, acc R a) → well_founded R

namespace well_founded
  definition apply [coercion] {A : Type} {R : A → A → Prop} (wf : well_founded R) : ∀a, acc R a :=
  take a, well_founded.rec_on wf (λp, p) a

  section
  parameters {A : Type} {R : A → A → Prop}
  local infix `≺`:50    := R

  hypothesis [Hwf : well_founded R]

  theorem recursion {C : A → Type} (a : A) (H : Πx, (Πy, y ≺ x → C y) → C x) : C a :=
  acc.rec_on (Hwf a) (λ x₁ ac₁ iH, H x₁ iH)

  theorem induction {C : A → Prop} (a : A) (H : ∀x, (∀y, y ≺ x → C y) → C x) : C a :=
  recursion a H

  variable {C : A → Type}
  variable F : Πx, (Πy, y ≺ x → C y) → C x

  definition fix_F (x : A) (a : acc R x) : C x :=
  acc.rec_on a (λ x₁ ac₁ iH, F x₁ iH)

  theorem fix_F_eq (x : A) (r : acc R x) :
    fix_F F x r = F x (λ (y : A) (p : y ≺ x), fix_F F y (acc.inv r p)) :=
  begin
    induction r using acc.drec,
    reflexivity -- proof is trivial due to proof irrelevance
  end
  end

  variables {A : Type} {C : A → Type} {R : A → A → Prop}

  -- Well-founded fixpoint
  definition fix [Hwf : well_founded R] (F : Πx, (Πy, R y x → C y) → C x) (x : A) : C x :=
  fix_F F x (Hwf x)

  -- Well-founded fixpoint satisfies fixpoint equation

open well_founded

-- Empty relation is well-founded
definition empty.wf {A : Type} : well_founded empty_relation :=
well_founded.intro (λ (a : A),
  acc.intro a (λ (b : A) (lt : false), false.rec _ lt))

-- Subrelation of a well-founded relation is well-founded
namespace subrelation
section
  parameters {A : Type} {R Q : A → A → Prop}
  parameters (H₁ : subrelation Q R)
  parameters (H₂ : well_founded R)

  definition accessible {a : A} (ac : acc R a) : acc Q a :=
  using H₁,
  begin
    induction ac with x ax ih, constructor,
    exact λ (y : A) (lt : Q y x), ih y (H₁ lt)
  end

  definition wf : well_founded Q :=
  well_founded.intro (λ a, accessible (H₂ a))
end
end subrelation

-- The inverse image of a well-founded relation is well-founded
namespace inv_image
section
  parameters {A B : Type} {R : B → B → Prop}
  parameters (f : A → B)
  parameters (H : well_founded R)

  private definition acc_aux {b : B} (ac : acc R b) : ∀ x, f x = b → acc (inv_image R f) x :=
  begin
    induction ac with x acx ih,
    intro z e, constructor,
    intro y lt, subst x,
    exact ih (f y) lt y rfl
  end

  definition accessible {a : A} (ac : acc R (f a)) : acc (inv_image R f) a :=
  acc_aux ac a rfl

  definition wf : well_founded (inv_image R f) :=
  well_founded.intro (λ a, accessible (H (f a)))
end
end inv_image

-- The transitive closure of a well-founded relation is well-founded
namespace tc
section
  parameters {A : Type} {R : A → A → Prop}
  local notation `R⁺` := tc R

  definition accessible {z} (ac: acc R z) : acc R⁺ z :=
  begin
    induction ac with x acx ih,
    constructor, intro y rel,
    induction rel with a b rab a b c rab rbc ih₁ ih₂,
      {exact ih a rab},
      {exact acc.inv (ih₂ acx ih) rab}
  end

  definition wf (H : well_founded R) : well_founded R⁺ :=
  well_founded.intro (λ a, accessible (H a))
end
end tc

namespace nat

  -- less-than is well-founded
  definition lt.wf [instance] : well_founded lt :=
  well_founded.intro (nat.rec
    (!acc.intro (λn H, absurd H (not_lt_zero n)))
    (λn IH, !acc.intro (λm H,
      or.elim (nat.eq_or_lt_of_le (le_of_succ_le_succ H))
        (λe, eq.substr e IH) (acc.inv IH))))

  definition measure {A : Type} : (A → ℕ) → A → A → Prop :=
  inv_image lt

  definition measure.wf {A : Type} (f : A → ℕ) : well_founded (measure f) :=
  inv_image.wf f lt.wf

end nat

namespace prod
  open well_founded

  section
  variables {A B : Type}
  variable  (Ra  : A → A → Prop)
  variable  (Rb  : B → B → Prop)

  -- Lexicographical order based on Ra and Rb
  inductive lex : A × B → A × B → Prop :=
  | left  : ∀{a₁ b₁} a₂ b₂, Ra a₁ a₂ → lex (a₁, b₁) (a₂, b₂)
  | right : ∀a {b₁ b₂},     Rb b₁ b₂ → lex (a, b₁)  (a, b₂)

  -- Relational product based on Ra and Rb
  inductive rprod : A × B → A × B → Prop :=
  intro : ∀{a₁ b₁ a₂ b₂}, Ra a₁ a₂ → Rb b₁ b₂ → rprod (a₁, b₁) (a₂, b₂)
  end

  section
  parameters {A B : Type}
  parameters {Ra  : A → A → Prop} {Rb  : B → B → Prop}
  local infix `≺`:50 := lex Ra Rb

  definition lex.accessible {a} (aca : acc Ra a) (acb : ∀b, acc Rb b): ∀b, acc (lex Ra Rb) (a, b) :=
  acc.rec_on aca
    (λxa aca (iHa : ∀y, Ra y xa → ∀b, acc (lex Ra Rb) (y, b)),
      λb, acc.rec_on (acb b)
        (λxb acb
          (iHb : ∀y, Rb y xb → acc (lex Ra Rb) (xa, y)),
          acc.intro (xa, xb) (λp (lt : p ≺ (xa, xb)),
            have aux : xa = xa → xb = xb → acc (lex Ra Rb) p, from
              @prod.lex.rec_on A B Ra Rb (λp₁ p₂, pr₁ p₂ = xa → pr₂ p₂ = xb → acc (lex Ra Rb) p₁)
                               p (xa, xb) lt
                (λa₁ b₁ a₂ b₂ (H : Ra a₁ a₂) (eq₂ : a₂ = xa) (eq₃ : b₂ = xb),
                  show acc (lex Ra Rb) (a₁, b₁), from
                  have Ra₁  : Ra a₁ xa, from eq.rec_on eq₂ H,
                  iHa a₁ Ra₁ b₁)
                (λa b₁ b₂ (H : Rb b₁ b₂) (eq₂ : a = xa) (eq₃ : b₂ = xb),
                  show acc (lex Ra Rb) (a, b₁), from
                  have Rb₁  : Rb b₁ xb, from eq.rec_on eq₃ H,
                  have eq₂' : xa = a, from eq.rec_on eq₂ rfl,
                  eq.rec_on eq₂' (iHb b₁ Rb₁)),
            aux rfl rfl)))

  -- The lexicographical order of well founded relations is well-founded
  definition lex.wf (Ha : well_founded Ra) (Hb : well_founded Rb) : well_founded (lex Ra Rb) :=
  well_founded.intro (λp, destruct p (λa b, lex.accessible (Ha a) (well_founded.apply Hb) b))

  -- Relational product is a subrelation of the lex
  definition rprod.sub_lex : ∀ a b, rprod Ra Rb a b → lex Ra Rb a b :=
  λa b H, prod.rprod.rec_on H (λ a₁ b₁ a₂ b₂ H₁ H₂, lex.left Rb a₂ b₂ H₁)

  -- The relational product of well founded relations is well-founded
  definition rprod.wf (Ha : well_founded Ra) (Hb : well_founded Rb) : well_founded (rprod Ra Rb) :=
  subrelation.wf (rprod.sub_lex) (lex.wf Ha Hb)

  end

end prod


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Wrenna Robson

! This file was ported from Lean 3 source module linear_algebra.lagrange
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.BigOperators.Basic
import Mathbin.LinearAlgebra.Vandermonde
import Mathbin.RingTheory.Polynomial.Basic

/-!
# Lagrange interpolation

## Main definitions
* In everything that follows, `s : finset ι` is a finite set of indexes, with `v : ι → F` an
indexing of the field over some type. We call the image of v on s the interpolation nodes,
though strictly unique nodes are only defined when v is injective on s.
* `lagrange.basis_divisor x y`, with `x y : F`. These are the normalised irreducible factors of
the Lagrange basis polynomials. They evaluate to `1` at `x` and `0` at `y` when `x` and `y`
are distinct.
* `lagrange.basis v i` with `i : ι`: the Lagrange basis polynomial that evaluates to `1` at `v i`
and `0` at `v j` for `i ≠ j`.
* `lagrange.interpolate v r` where `r : ι → F` is a function from the fintype to the field: the
Lagrange interpolant that evaluates to `r i` at `x i` for all `i : ι`. The `r i` are the _values_
associated with the _nodes_`x i`.
* `lagrange.interpolate_at v f`, where `v : ι ↪ F` and `ι` is a fintype, and `f : F → F` is a
function from the field to itself: this is the Lagrange interpolant that evaluates to `f (x i)`
at `x i`, and so approximates the function `f`. This is just a special case of the general
interpolation, where the values are given by a known function `f`.
-/

open Polynomial BigOperators

section PolynomialDetermination

namespace Polynomial

variable {R : Type _} [CommRing R] [IsDomain R] {f g : R[X]}

section Finset

open Function Fintype

variable (s : Finset R)

theorem eq_zero_of_degree_lt_of_eval_finset_eq_zero (degree_f_lt : f.degree < s.card)
    (eval_f : ∀ x ∈ s, f.eval x = 0) : f = 0 :=
  by
  rw [← mem_degree_lt] at degree_f_lt
  simp_rw [eval_eq_sum_degree_lt_equiv degree_f_lt] at eval_f
  rw [← degree_lt_equiv_eq_zero_iff_eq_zero degree_f_lt]
  exact
    Matrix.eq_zero_of_forall_index_sum_mul_pow_eq_zero
      (injective.comp (embedding.subtype _).inj' (equiv_fin_of_card_eq (card_coe _)).symm.Injective)
      fun _ => eval_f _ (Finset.coe_mem _)
#align polynomial.eq_zero_of_degree_lt_of_eval_finset_eq_zero Polynomial.eq_zero_of_degree_lt_of_eval_finset_eq_zero

theorem eq_of_degree_sub_lt_of_eval_finset_eq (degree_fg_lt : (f - g).degree < s.card)
    (eval_fg : ∀ x ∈ s, f.eval x = g.eval x) : f = g :=
  by
  rw [← sub_eq_zero]
  refine' eq_zero_of_degree_lt_of_eval_finset_eq_zero _ degree_fg_lt _
  simp_rw [eval_sub, sub_eq_zero]
  exact eval_fg
#align polynomial.eq_of_degree_sub_lt_of_eval_finset_eq Polynomial.eq_of_degree_sub_lt_of_eval_finset_eq

theorem eq_of_degrees_lt_of_eval_finset_eq (degree_f_lt : f.degree < s.card)
    (degree_g_lt : g.degree < s.card) (eval_fg : ∀ x ∈ s, f.eval x = g.eval x) : f = g :=
  by
  rw [← mem_degree_lt] at degree_f_lt degree_g_lt
  refine' eq_of_degree_sub_lt_of_eval_finset_eq _ _ eval_fg
  rw [← mem_degree_lt]; exact Submodule.sub_mem _ degree_f_lt degree_g_lt
#align polynomial.eq_of_degrees_lt_of_eval_finset_eq Polynomial.eq_of_degrees_lt_of_eval_finset_eq

end Finset

section Indexed

open Finset

variable {ι : Type _} {v : ι → R} (s : Finset ι)

theorem eq_zero_of_degree_lt_of_eval_index_eq_zero (hvs : Set.InjOn v s)
    (degree_f_lt : f.degree < s.card) (eval_f : ∀ i ∈ s, f.eval (v i) = 0) : f = 0 := by
  classical
    rw [← card_image_of_inj_on hvs] at degree_f_lt
    refine' eq_zero_of_degree_lt_of_eval_finset_eq_zero _ degree_f_lt _
    intro x hx
    rcases mem_image.mp hx with ⟨_, hj, rfl⟩
    exact eval_f _ hj
#align polynomial.eq_zero_of_degree_lt_of_eval_index_eq_zero Polynomial.eq_zero_of_degree_lt_of_eval_index_eq_zero

theorem eq_of_degree_sub_lt_of_eval_index_eq (hvs : Set.InjOn v s)
    (degree_fg_lt : (f - g).degree < s.card) (eval_fg : ∀ i ∈ s, f.eval (v i) = g.eval (v i)) :
    f = g := by
  rw [← sub_eq_zero]
  refine' eq_zero_of_degree_lt_of_eval_index_eq_zero _ hvs degree_fg_lt _
  simp_rw [eval_sub, sub_eq_zero]
  exact eval_fg
#align polynomial.eq_of_degree_sub_lt_of_eval_index_eq Polynomial.eq_of_degree_sub_lt_of_eval_index_eq

theorem eq_of_degrees_lt_of_eval_index_eq (hvs : Set.InjOn v s) (degree_f_lt : f.degree < s.card)
    (degree_g_lt : g.degree < s.card) (eval_fg : ∀ i ∈ s, f.eval (v i) = g.eval (v i)) : f = g :=
  by
  refine' eq_of_degree_sub_lt_of_eval_index_eq _ hvs _ eval_fg
  rw [← mem_degree_lt] at degree_f_lt degree_g_lt⊢
  exact Submodule.sub_mem _ degree_f_lt degree_g_lt
#align polynomial.eq_of_degrees_lt_of_eval_index_eq Polynomial.eq_of_degrees_lt_of_eval_index_eq

end Indexed

end Polynomial

end PolynomialDetermination

noncomputable section

namespace Lagrange

open Polynomial

variable {F : Type _} [Field F]

section BasisDivisor

variable {x y : F}

/-- `basis_divisor x y` is the unique linear or constant polynomial such that
when evaluated at `x` it gives `1` and `y` it gives `0` (where when `x = y` it is identically `0`).
Such polynomials are the building blocks for the Lagrange interpolants. -/
def basisDivisor (x y : F) : F[X] :=
  C (x - y)⁻¹ * (X - C y)
#align lagrange.basis_divisor Lagrange.basisDivisor

theorem basisDivisor_self : basisDivisor x x = 0 := by
  simp only [basis_divisor, sub_self, inv_zero, map_zero, MulZeroClass.zero_mul]
#align lagrange.basis_divisor_self Lagrange.basisDivisor_self

theorem basisDivisor_inj (hxy : basisDivisor x y = 0) : x = y :=
  by
  simp_rw [basis_divisor, mul_eq_zero, X_sub_C_ne_zero, or_false_iff, C_eq_zero, inv_eq_zero,
    sub_eq_zero] at hxy
  exact hxy
#align lagrange.basis_divisor_inj Lagrange.basisDivisor_inj

@[simp]
theorem basisDivisor_eq_zero_iff : basisDivisor x y = 0 ↔ x = y :=
  ⟨basisDivisor_inj, fun H => H ▸ basisDivisor_self⟩
#align lagrange.basis_divisor_eq_zero_iff Lagrange.basisDivisor_eq_zero_iff

theorem basisDivisor_ne_zero_iff : basisDivisor x y ≠ 0 ↔ x ≠ y := by
  rw [Ne.def, basis_divisor_eq_zero_iff]
#align lagrange.basis_divisor_ne_zero_iff Lagrange.basisDivisor_ne_zero_iff

theorem degree_basisDivisor_of_ne (hxy : x ≠ y) : (basisDivisor x y).degree = 1 :=
  by
  rw [basis_divisor, degree_mul, degree_X_sub_C, degree_C, zero_add]
  exact inv_ne_zero (sub_ne_zero_of_ne hxy)
#align lagrange.degree_basis_divisor_of_ne Lagrange.degree_basisDivisor_of_ne

@[simp]
theorem degree_basisDivisor_self : (basisDivisor x x).degree = ⊥ := by
  rw [basis_divisor_self, degree_zero]
#align lagrange.degree_basis_divisor_self Lagrange.degree_basisDivisor_self

theorem natDegree_basisDivisor_self : (basisDivisor x x).natDegree = 0 := by
  rw [basis_divisor_self, nat_degree_zero]
#align lagrange.nat_degree_basis_divisor_self Lagrange.natDegree_basisDivisor_self

theorem natDegree_basisDivisor_of_ne (hxy : x ≠ y) : (basisDivisor x y).natDegree = 1 :=
  natDegree_eq_of_degree_eq_some (degree_basisDivisor_of_ne hxy)
#align lagrange.nat_degree_basis_divisor_of_ne Lagrange.natDegree_basisDivisor_of_ne

@[simp]
theorem eval_basisDivisor_right : eval y (basisDivisor x y) = 0 := by
  simp only [basis_divisor, eval_mul, eval_C, eval_sub, eval_X, sub_self, MulZeroClass.mul_zero]
#align lagrange.eval_basis_divisor_right Lagrange.eval_basisDivisor_right

theorem eval_basisDivisor_left_of_ne (hxy : x ≠ y) : eval x (basisDivisor x y) = 1 :=
  by
  simp only [basis_divisor, eval_mul, eval_C, eval_sub, eval_X]
  exact inv_mul_cancel (sub_ne_zero_of_ne hxy)
#align lagrange.eval_basis_divisor_left_of_ne Lagrange.eval_basisDivisor_left_of_ne

end BasisDivisor

section Basis

open Finset

variable {ι : Type _} [DecidableEq ι] {s : Finset ι} {v : ι → F} {i j : ι}

/-- Lagrange basis polynomials indexed by `s : finset ι`, defined at nodes `v i` for a
map `v : ι → F`. For `i, j ∈ s`, `basis s v i` evaluates to 0 at `v j` for `i ≠ j`. When
`v` is injective on `s`, `basis s v i` evaluates to 1 at `v i`. -/
protected def basis (s : Finset ι) (v : ι → F) (i : ι) : F[X] :=
  ∏ j in s.eraseₓ i, basisDivisor (v i) (v j)
#align lagrange.basis Lagrange.basis

@[simp]
theorem basis_empty : Lagrange.basis ∅ v i = 1 :=
  rfl
#align lagrange.basis_empty Lagrange.basis_empty

@[simp]
theorem basis_singleton (i : ι) : Lagrange.basis {i} v i = 1 := by
  rw [Lagrange.basis, erase_singleton, prod_empty]
#align lagrange.basis_singleton Lagrange.basis_singleton

@[simp]
theorem basis_pair_left (hij : i ≠ j) : Lagrange.basis {i, j} v i = basisDivisor (v i) (v j) := by
  simp only [Lagrange.basis, hij, erase_insert_eq_erase, erase_eq_of_not_mem, mem_singleton,
    not_false_iff, prod_singleton]
#align lagrange.basis_pair_left Lagrange.basis_pair_left

@[simp]
theorem basis_pair_right (hij : i ≠ j) : Lagrange.basis {i, j} v j = basisDivisor (v j) (v i) :=
  by
  rw [pair_comm]
  exact basis_pair_left hij.symm
#align lagrange.basis_pair_right Lagrange.basis_pair_right

theorem basis_ne_zero (hvs : Set.InjOn v s) (hi : i ∈ s) : Lagrange.basis s v i ≠ 0 :=
  by
  simp_rw [Lagrange.basis, prod_ne_zero_iff, Ne.def, mem_erase]
  rintro j ⟨hij, hj⟩
  rw [basis_divisor_eq_zero_iff, hvs.eq_iff hi hj]
  exact hij.symm
#align lagrange.basis_ne_zero Lagrange.basis_ne_zero

@[simp]
theorem eval_basis_self (hvs : Set.InjOn v s) (hi : i ∈ s) :
    (Lagrange.basis s v i).eval (v i) = 1 :=
  by
  rw [Lagrange.basis, eval_prod]
  refine' prod_eq_one fun j H => _
  rw [eval_basis_divisor_left_of_ne]
  rcases mem_erase.mp H with ⟨hij, hj⟩
  exact mt (hvs hi hj) hij.symm
#align lagrange.eval_basis_self Lagrange.eval_basis_self

@[simp]
theorem eval_basis_of_ne (hij : i ≠ j) (hj : j ∈ s) : (Lagrange.basis s v i).eval (v j) = 0 :=
  by
  simp_rw [Lagrange.basis, eval_prod, prod_eq_zero_iff]
  exact ⟨j, ⟨mem_erase.mpr ⟨hij.symm, hj⟩, eval_basis_divisor_right⟩⟩
#align lagrange.eval_basis_of_ne Lagrange.eval_basis_of_ne

@[simp]
theorem natDegree_basis (hvs : Set.InjOn v s) (hi : i ∈ s) :
    (Lagrange.basis s v i).natDegree = s.card - 1 :=
  by
  have H : ∀ j, j ∈ s.erase i → basis_divisor (v i) (v j) ≠ 0 :=
    by
    simp_rw [Ne.def, mem_erase, basis_divisor_eq_zero_iff]
    exact fun j ⟨hij₁, hj⟩ hij₂ => hij₁ (hvs hj hi hij₂.symm)
  rw [← card_erase_of_mem hi, card_eq_sum_ones]
  convert nat_degree_prod _ _ H using 1
  refine' sum_congr rfl fun j hj => (nat_degree_basis_divisor_of_ne _).symm
  rw [Ne.def, ← basis_divisor_eq_zero_iff]
  exact H _ hj
#align lagrange.nat_degree_basis Lagrange.natDegree_basis

theorem degree_basis (hvs : Set.InjOn v s) (hi : i ∈ s) :
    (Lagrange.basis s v i).degree = ↑(s.card - 1) := by
  rw [degree_eq_nat_degree (basis_ne_zero hvs hi), nat_degree_basis hvs hi]
#align lagrange.degree_basis Lagrange.degree_basis

theorem sum_basis (hvs : Set.InjOn v s) (hs : s.Nonempty) : (∑ j in s, Lagrange.basis s v j) = 1 :=
  by
  refine' eq_of_degrees_lt_of_eval_index_eq s hvs (lt_of_le_of_lt (degree_sum_le _ _) _) _ _
  · rw [Finset.sup_lt_iff (WithBot.bot_lt_coe s.card)]
    intro i hi
    rw [degree_basis hvs hi, WithBot.coe_lt_coe]
    exact Nat.pred_lt (card_ne_zero_of_mem hi)
  · rw [degree_one, ← WithBot.coe_zero, WithBot.coe_lt_coe]
    exact nonempty.card_pos hs
  · intro i hi
    rw [eval_finset_sum, eval_one, ← add_sum_erase _ _ hi, eval_basis_self hvs hi,
      add_right_eq_self]
    refine' sum_eq_zero fun j hj => _
    rcases mem_erase.mp hj with ⟨hij, hj⟩
    rw [eval_basis_of_ne hij hi]
#align lagrange.sum_basis Lagrange.sum_basis

theorem basisDivisor_add_symm {x y : F} (hxy : x ≠ y) : basisDivisor x y + basisDivisor y x = 1 :=
  by
  classical rw [←
      sum_basis (Set.injOn_of_injective Function.injective_id _) ⟨x, mem_insert_self _ {y}⟩,
      sum_insert (not_mem_singleton.mpr hxy), sum_singleton, basis_pair_left hxy,
      basis_pair_right hxy, id, id]
#align lagrange.basis_divisor_add_symm Lagrange.basisDivisor_add_symm

end Basis

section Interpolate

open Finset

variable {ι : Type _} [DecidableEq ι] {s t : Finset ι} {i j : ι} {v : ι → F} (r r' : ι → F)

/-- Lagrange interpolation: given a finset `s : finset ι`, a nodal map  `v : ι → F` injective on
`s` and a value function `r : ι → F`,  `interpolate s v r` is the unique
polynomial of degree `< s.card` that takes value `r i` on `v i` for all `i` in `s`. -/
@[simps]
def interpolate (s : Finset ι) (v : ι → F) : (ι → F) →ₗ[F] F[X]
    where
  toFun r := ∑ i in s, C (r i) * Lagrange.basis s v i
  map_add' f g := by simp_rw [← Finset.sum_add_distrib, ← add_mul, ← C_add, Pi.add_apply]
  map_smul' c f := by
    simp_rw [Finset.smul_sum, C_mul', smul_smul, Pi.smul_apply, RingHom.id_apply, smul_eq_mul]
#align lagrange.interpolate Lagrange.interpolate

@[simp]
theorem interpolate_empty : interpolate ∅ v r = 0 := by rw [interpolate_apply, sum_empty]
#align lagrange.interpolate_empty Lagrange.interpolate_empty

@[simp]
theorem interpolate_singleton : interpolate {i} v r = C (r i) := by
  rw [interpolate_apply, sum_singleton, basis_singleton, mul_one]
#align lagrange.interpolate_singleton Lagrange.interpolate_singleton

theorem interpolate_one (hvs : Set.InjOn v s) (hs : s.Nonempty) : interpolate s v 1 = 1 :=
  by
  simp_rw [interpolate_apply, Pi.one_apply, map_one, one_mul]
  exact sum_basis hvs hs
#align lagrange.interpolate_one Lagrange.interpolate_one

theorem eval_interpolate_at_node (hvs : Set.InjOn v s) (hi : i ∈ s) :
    eval (v i) (interpolate s v r) = r i :=
  by
  rw [interpolate_apply, eval_finset_sum, ← add_sum_erase _ _ hi]
  simp_rw [eval_mul, eval_C, eval_basis_self hvs hi, mul_one, add_right_eq_self]
  refine' sum_eq_zero fun j H => _
  rw [eval_basis_of_ne (mem_erase.mp H).1 hi, MulZeroClass.mul_zero]
#align lagrange.eval_interpolate_at_node Lagrange.eval_interpolate_at_node

theorem degree_interpolate_le (hvs : Set.InjOn v s) : (interpolate s v r).degree ≤ ↑(s.card - 1) :=
  by
  refine' (degree_sum_le _ _).trans _
  rw [Finset.sup_le_iff]
  intro i hi
  rw [degree_mul, degree_basis hvs hi]
  by_cases hr : r i = 0
  · simpa only [hr, map_zero, degree_zero, WithBot.bot_add] using bot_le
  · rw [degree_C hr, zero_add, WithBot.coe_le_coe]
#align lagrange.degree_interpolate_le Lagrange.degree_interpolate_le

theorem degree_interpolate_lt (hvs : Set.InjOn v s) : (interpolate s v r).degree < s.card :=
  by
  rcases eq_empty_or_nonempty s with (rfl | h)
  · rw [interpolate_empty, degree_zero, card_empty]
    exact WithBot.bot_lt_coe _
  · refine' lt_of_le_of_lt (degree_interpolate_le _ hvs) _
    rw [WithBot.coe_lt_coe]
    exact Nat.sub_lt (nonempty.card_pos h) zero_lt_one
#align lagrange.degree_interpolate_lt Lagrange.degree_interpolate_lt

theorem degree_interpolate_erase_lt (hvs : Set.InjOn v s) (hi : i ∈ s) :
    (interpolate (s.eraseₓ i) v r).degree < ↑(s.card - 1) :=
  by
  rw [← Finset.card_erase_of_mem hi]
  exact degree_interpolate_lt _ (Set.InjOn.mono (coe_subset.mpr (erase_subset _ _)) hvs)
#align lagrange.degree_interpolate_erase_lt Lagrange.degree_interpolate_erase_lt

theorem values_eq_on_of_interpolate_eq (hvs : Set.InjOn v s)
    (hrr' : interpolate s v r = interpolate s v r') : ∀ i ∈ s, r i = r' i := fun _ hi => by
  rw [← eval_interpolate_at_node r hvs hi, hrr', eval_interpolate_at_node r' hvs hi]
#align lagrange.values_eq_on_of_interpolate_eq Lagrange.values_eq_on_of_interpolate_eq

theorem interpolate_eq_of_values_eq_on (hrr' : ∀ i ∈ s, r i = r' i) :
    interpolate s v r = interpolate s v r' :=
  sum_congr rfl fun i hi => by rw [hrr' _ hi]
#align lagrange.interpolate_eq_of_values_eq_on Lagrange.interpolate_eq_of_values_eq_on

theorem interpolate_eq_iff_values_eq_on (hvs : Set.InjOn v s) :
    interpolate s v r = interpolate s v r' ↔ ∀ i ∈ s, r i = r' i :=
  ⟨values_eq_on_of_interpolate_eq _ _ hvs, interpolate_eq_of_values_eq_on _ _⟩
#align lagrange.interpolate_eq_iff_values_eq_on Lagrange.interpolate_eq_iff_values_eq_on

theorem eq_interpolate {f : F[X]} (hvs : Set.InjOn v s) (degree_f_lt : f.degree < s.card) :
    f = interpolate s v fun i => f.eval (v i) :=
  eq_of_degrees_lt_of_eval_index_eq _ hvs degree_f_lt (degree_interpolate_lt _ hvs) fun i hi =>
    (eval_interpolate_at_node _ hvs hi).symm
#align lagrange.eq_interpolate Lagrange.eq_interpolate

theorem eq_interpolate_of_eval_eq {f : F[X]} (hvs : Set.InjOn v s) (degree_f_lt : f.degree < s.card)
    (eval_f : ∀ i ∈ s, f.eval (v i) = r i) : f = interpolate s v r :=
  by
  rw [eq_interpolate hvs degree_f_lt]
  exact interpolate_eq_of_values_eq_on _ _ eval_f
#align lagrange.eq_interpolate_of_eval_eq Lagrange.eq_interpolate_of_eval_eq

/-- This is the characteristic property of the interpolation: the interpolation is the
unique polynomial of `degree < fintype.card ι` which takes the value of the `r i` on the `v i`.
-/
theorem eq_interpolate_iff {f : F[X]} (hvs : Set.InjOn v s) :
    (f.degree < s.card ∧ ∀ i ∈ s, eval (v i) f = r i) ↔ f = interpolate s v r :=
  by
  constructor <;> intro h
  · exact eq_interpolate_of_eval_eq _ hvs h.1 h.2
  · rw [h]
    exact ⟨degree_interpolate_lt _ hvs, fun _ hi => eval_interpolate_at_node _ hvs hi⟩
#align lagrange.eq_interpolate_iff Lagrange.eq_interpolate_iff

/-- Lagrange interpolation induces isomorphism between functions from `s`
and polynomials of degree less than `fintype.card ι`.-/
def funEquivDegreeLt (hvs : Set.InjOn v s) : degreeLt F s.card ≃ₗ[F] s → F
    where
  toFun f i := f.1.eval (v i)
  map_add' f g := funext fun v => eval_add
  map_smul' c f := funext <| by simp
  invFun r :=
    ⟨interpolate s v fun x => if hx : x ∈ s then r ⟨x, hx⟩ else 0,
      mem_degreeLt.2 <| degree_interpolate_lt _ hvs⟩
  left_inv := by
    rintro ⟨f, hf⟩
    simp only [Subtype.mk_eq_mk, Subtype.coe_mk, dite_eq_ite]
    rw [mem_degree_lt] at hf
    nth_rw_rhs 1 [eq_interpolate hvs hf]
    exact interpolate_eq_of_values_eq_on _ _ fun _ hi => if_pos hi
  right_inv := by
    intro f
    ext ⟨i, hi⟩
    simp only [Subtype.coe_mk, eval_interpolate_at_node _ hvs hi]
    exact dif_pos hi
#align lagrange.fun_equiv_degree_lt Lagrange.funEquivDegreeLt

theorem interpolate_eq_sum_interpolate_insert_sdiff (hvt : Set.InjOn v t) (hs : s.Nonempty)
    (hst : s ⊆ t) :
    interpolate t v r = ∑ i in s, interpolate (insert i (t \ s)) v r * Lagrange.basis s v i :=
  by
  symm
  refine' eq_interpolate_of_eval_eq _ hvt (lt_of_le_of_lt (degree_sum_le _ _) _) fun i hi => _
  · simp_rw [Finset.sup_lt_iff (WithBot.bot_lt_coe t.card), degree_mul]
    intro i hi
    have hs : 1 ≤ s.card := nonempty.card_pos ⟨_, hi⟩
    have hst' : s.card ≤ t.card := card_le_of_subset hst
    have H : t.card = 1 + (t.card - s.card) + (s.card - 1) := by
      rw [add_assoc, tsub_add_tsub_cancel hst' hs, ← add_tsub_assoc_of_le (hs.trans hst'),
        Nat.succ_add_sub_one, zero_add]
    rw [degree_basis (Set.InjOn.mono hst hvt) hi, H, WithBot.coe_add,
      WithBot.add_lt_add_iff_right (@WithBot.coe_ne_bot _ (s.card - 1))]
    convert degree_interpolate_lt _
        (hvt.mono (coe_subset.mpr (insert_subset.mpr ⟨hst hi, sdiff_subset _ _⟩)))
    rw [card_insert_of_not_mem (not_mem_sdiff_of_mem_right hi), card_sdiff hst, add_comm]
  · simp_rw [eval_finset_sum, eval_mul]
    by_cases hi' : i ∈ s
    · rw [← add_sum_erase _ _ hi', eval_basis_self (hvt.mono hst) hi',
        eval_interpolate_at_node _
          (hvt.mono (coe_subset.mpr (insert_subset.mpr ⟨hi, sdiff_subset _ _⟩)))
          (mem_insert_self _ _),
        mul_one, add_right_eq_self]
      refine' sum_eq_zero fun j hj => _
      rcases mem_erase.mp hj with ⟨hij, hj⟩
      rw [eval_basis_of_ne hij hi', MulZeroClass.mul_zero]
    · have H : (∑ j in s, eval (v i) (Lagrange.basis s v j)) = 1 := by
        rw [← eval_finset_sum, sum_basis (hvt.mono hst) hs, eval_one]
      rw [← mul_one (r i), ← H, mul_sum]
      refine' sum_congr rfl fun j hj => _
      congr
      exact
        eval_interpolate_at_node _ (hvt.mono (insert_subset.mpr ⟨hst hj, sdiff_subset _ _⟩))
          (mem_insert.mpr (Or.inr (mem_sdiff.mpr ⟨hi, hi'⟩)))
#align lagrange.interpolate_eq_sum_interpolate_insert_sdiff Lagrange.interpolate_eq_sum_interpolate_insert_sdiff

theorem interpolate_eq_add_interpolate_erase (hvs : Set.InjOn v s) (hi : i ∈ s) (hj : j ∈ s)
    (hij : i ≠ j) :
    interpolate s v r =
      interpolate (s.eraseₓ j) v r * basisDivisor (v i) (v j) +
        interpolate (s.eraseₓ i) v r * basisDivisor (v j) (v i) :=
  by
  rw [interpolate_eq_sum_interpolate_insert_sdiff _ hvs ⟨i, mem_insert_self i {j}⟩ _,
    sum_insert (not_mem_singleton.mpr hij), sum_singleton, basis_pair_left hij,
    basis_pair_right hij, sdiff_insert_insert_of_mem_of_not_mem hi (not_mem_singleton.mpr hij),
    sdiff_singleton_eq_erase, pair_comm,
    sdiff_insert_insert_of_mem_of_not_mem hj (not_mem_singleton.mpr hij.symm),
    sdiff_singleton_eq_erase]
  · exact insert_subset.mpr ⟨hi, singleton_subset_iff.mpr hj⟩
#align lagrange.interpolate_eq_add_interpolate_erase Lagrange.interpolate_eq_add_interpolate_erase

end Interpolate

section Nodal

open Finset Polynomial

variable {ι : Type _} {s : Finset ι} {v : ι → F} {i : ι} (r : ι → F) {x : F}

/-- `nodal s v` is the unique monic polynomial whose roots are the nodes defined by `v` and `s`.

That is, the roots of `nodal s v` are exactly the image of `v` on `s`,
with appropriate multiplicity.

We can use `nodal` to define the barycentric forms of the evaluated interpolant.
-/
def nodal (s : Finset ι) (v : ι → F) : F[X] :=
  ∏ i in s, X - C (v i)
#align lagrange.nodal Lagrange.nodal

theorem nodal_eq (s : Finset ι) (v : ι → F) : nodal s v = ∏ i in s, X - C (v i) :=
  rfl
#align lagrange.nodal_eq Lagrange.nodal_eq

@[simp]
theorem nodal_empty : nodal ∅ v = 1 :=
  rfl
#align lagrange.nodal_empty Lagrange.nodal_empty

theorem degree_nodal : (nodal s v).degree = s.card := by
  simp_rw [nodal, degree_prod, degree_X_sub_C, sum_const, Nat.smul_one_eq_coe]
#align lagrange.degree_nodal Lagrange.degree_nodal

theorem eval_nodal {x : F} : (nodal s v).eval x = ∏ i in s, x - v i := by
  simp_rw [nodal, eval_prod, eval_sub, eval_X, eval_C]
#align lagrange.eval_nodal Lagrange.eval_nodal

theorem eval_nodal_at_node (hi : i ∈ s) : eval (v i) (nodal s v) = 0 :=
  by
  rw [eval_nodal, prod_eq_zero_iff]
  exact ⟨i, hi, sub_eq_zero_of_eq rfl⟩
#align lagrange.eval_nodal_at_node Lagrange.eval_nodal_at_node

theorem eval_nodal_not_at_node (hx : ∀ i ∈ s, x ≠ v i) : eval x (nodal s v) ≠ 0 :=
  by
  simp_rw [nodal, eval_prod, prod_ne_zero_iff, eval_sub, eval_X, eval_C, sub_ne_zero]
  exact hx
#align lagrange.eval_nodal_not_at_node Lagrange.eval_nodal_not_at_node

theorem nodal_eq_mul_nodal_erase [DecidableEq ι] (hi : i ∈ s) :
    nodal s v = (X - C (v i)) * nodal (s.eraseₓ i) v := by simp_rw [nodal, mul_prod_erase _ _ hi]
#align lagrange.nodal_eq_mul_nodal_erase Lagrange.nodal_eq_mul_nodal_erase

theorem x_sub_c_dvd_nodal (v : ι → F) (hi : i ∈ s) : X - C (v i) ∣ nodal s v :=
  ⟨_, by classical exact nodal_eq_mul_nodal_erase hi⟩
#align lagrange.X_sub_C_dvd_nodal Lagrange.x_sub_c_dvd_nodal

variable [DecidableEq ι]

theorem nodal_erase_eq_nodal_div (hi : i ∈ s) : nodal (s.eraseₓ i) v = nodal s v / (X - C (v i)) :=
  by
  rw [nodal_eq_mul_nodal_erase hi, EuclideanDomain.mul_div_cancel_left]
  exact X_sub_C_ne_zero _
#align lagrange.nodal_erase_eq_nodal_div Lagrange.nodal_erase_eq_nodal_div

theorem nodal_insert_eq_nodal (hi : i ∉ s) : nodal (insert i s) v = (X - C (v i)) * nodal s v := by
  simp_rw [nodal, prod_insert hi]
#align lagrange.nodal_insert_eq_nodal Lagrange.nodal_insert_eq_nodal

theorem derivative_nodal : (nodal s v).derivative = ∑ i in s, nodal (s.eraseₓ i) v :=
  by
  refine' Finset.induction_on s _ fun _ _ hit IH => _
  · rw [nodal_empty, derivative_one, sum_empty]
  · rw [nodal_insert_eq_nodal hit, derivative_mul, IH, derivative_sub, derivative_X, derivative_C,
      sub_zero, one_mul, sum_insert hit, mul_sum, erase_insert hit, add_right_inj]
    refine' sum_congr rfl fun j hjt => _
    rw [nodal_erase_eq_nodal_div (mem_insert_of_mem hjt), nodal_insert_eq_nodal hit,
      EuclideanDomain.mul_div_assoc _ (X_sub_C_dvd_nodal v hjt), nodal_erase_eq_nodal_div hjt]
#align lagrange.derivative_nodal Lagrange.derivative_nodal

theorem eval_nodal_derivative_eval_node_eq (hi : i ∈ s) :
    eval (v i) (nodal s v).derivative = eval (v i) (nodal (s.eraseₓ i) v) :=
  by
  rw [derivative_nodal, eval_finset_sum, ← add_sum_erase _ _ hi, add_right_eq_self]
  refine' sum_eq_zero fun j hj => _
  simp_rw [nodal, eval_prod, eval_sub, eval_X, eval_C, prod_eq_zero_iff, mem_erase]
  exact ⟨i, ⟨(mem_erase.mp hj).1.symm, hi⟩, sub_eq_zero_of_eq rfl⟩
#align lagrange.eval_nodal_derivative_eval_node_eq Lagrange.eval_nodal_derivative_eval_node_eq

/-- This defines the nodal weight for a given set of node indexes and node mapping function `v`. -/
def nodalWeight (s : Finset ι) (v : ι → F) (i : ι) :=
  ∏ j in s.eraseₓ i, (v i - v j)⁻¹
#align lagrange.nodal_weight Lagrange.nodalWeight

theorem nodalWeight_eq_eval_nodal_erase_inv :
    nodalWeight s v i = (eval (v i) (nodal (s.eraseₓ i) v))⁻¹ := by
  rw [eval_nodal, nodal_weight, prod_inv_distrib]
#align lagrange.nodal_weight_eq_eval_nodal_erase_inv Lagrange.nodalWeight_eq_eval_nodal_erase_inv

theorem nodalWeight_eq_eval_nodal_derative (hi : i ∈ s) :
    nodalWeight s v i = (eval (v i) (nodal s v).derivative)⁻¹ := by
  rw [eval_nodal_derivative_eval_node_eq hi, nodal_weight_eq_eval_nodal_erase_inv]
#align lagrange.nodal_weight_eq_eval_nodal_derative Lagrange.nodalWeight_eq_eval_nodal_derative

theorem nodalWeight_ne_zero (hvs : Set.InjOn v s) (hi : i ∈ s) : nodalWeight s v i ≠ 0 :=
  by
  rw [nodal_weight, prod_ne_zero_iff]
  intro j hj
  rcases mem_erase.mp hj with ⟨hij, hj⟩
  refine' inv_ne_zero (sub_ne_zero_of_ne (mt (hvs.eq_iff hi hj).mp hij.symm))
#align lagrange.nodal_weight_ne_zero Lagrange.nodalWeight_ne_zero

theorem basis_eq_prod_sub_inv_mul_nodal_div (hi : i ∈ s) :
    Lagrange.basis s v i = C (nodalWeight s v i) * (nodal s v / (X - C (v i))) := by
  simp_rw [Lagrange.basis, basis_divisor, nodal_weight, prod_mul_distrib, map_prod, ←
    nodal_erase_eq_nodal_div hi, nodal]
#align lagrange.basis_eq_prod_sub_inv_mul_nodal_div Lagrange.basis_eq_prod_sub_inv_mul_nodal_div

theorem eval_basis_not_at_node (hi : i ∈ s) (hxi : x ≠ v i) :
    eval x (Lagrange.basis s v i) = eval x (nodal s v) * (nodalWeight s v i * (x - v i)⁻¹) := by
  rw [mul_comm, basis_eq_prod_sub_inv_mul_nodal_div hi, eval_mul, eval_C, ←
    nodal_erase_eq_nodal_div hi, eval_nodal, eval_nodal, mul_assoc, ← mul_prod_erase _ _ hi, ←
    mul_assoc (x - v i)⁻¹, inv_mul_cancel (sub_ne_zero_of_ne hxi), one_mul]
#align lagrange.eval_basis_not_at_node Lagrange.eval_basis_not_at_node

theorem interpolate_eq_nodalWeight_mul_nodal_div_x_sub_c :
    interpolate s v r = ∑ i in s, C (nodalWeight s v i) * (nodal s v / (X - C (v i))) * C (r i) :=
  sum_congr rfl fun j hj => by rw [mul_comm, basis_eq_prod_sub_inv_mul_nodal_div hj]
#align lagrange.interpolate_eq_nodal_weight_mul_nodal_div_X_sub_C Lagrange.interpolate_eq_nodalWeight_mul_nodal_div_x_sub_c

/-- This is the first barycentric form of the Lagrange interpolant. -/
theorem eval_interpolate_not_at_node (hx : ∀ i ∈ s, x ≠ v i) :
    eval x (interpolate s v r) =
      eval x (nodal s v) * ∑ i in s, nodalWeight s v i * (x - v i)⁻¹ * r i :=
  by
  simp_rw [interpolate_apply, mul_sum, eval_finset_sum, eval_mul, eval_C]
  refine' sum_congr rfl fun i hi => _
  rw [← mul_assoc, mul_comm, eval_basis_not_at_node hi (hx _ hi)]
#align lagrange.eval_interpolate_not_at_node Lagrange.eval_interpolate_not_at_node

theorem sum_nodalWeight_mul_inv_sub_ne_zero (hvs : Set.InjOn v s) (hx : ∀ i ∈ s, x ≠ v i)
    (hs : s.Nonempty) : (∑ i in s, nodalWeight s v i * (x - v i)⁻¹) ≠ 0 :=
  @right_ne_zero_of_mul_eq_one _ _ _ (eval x (nodal s v)) _ <| by
    simpa only [Pi.one_apply, interpolate_one hvs hs, eval_one, mul_one] using
      (eval_interpolate_not_at_node 1 hx).symm
#align lagrange.sum_nodal_weight_mul_inv_sub_ne_zero Lagrange.sum_nodalWeight_mul_inv_sub_ne_zero

/-- This is the second barycentric form of the Lagrange interpolant. -/
theorem eval_interpolate_not_at_node' (hvs : Set.InjOn v s) (hs : s.Nonempty)
    (hx : ∀ i ∈ s, x ≠ v i) :
    eval x (interpolate s v r) =
      (∑ i in s, nodalWeight s v i * (x - v i)⁻¹ * r i) /
        ∑ i in s, nodalWeight s v i * (x - v i)⁻¹ :=
  by
  rw [← div_one (eval x (interpolate s v r)), ← @eval_one _ _ x, ← interpolate_one hvs hs,
    eval_interpolate_not_at_node r hx, eval_interpolate_not_at_node 1 hx]
  simp only [mul_div_mul_left _ _ (eval_nodal_not_at_node hx), Pi.one_apply, mul_one]
#align lagrange.eval_interpolate_not_at_node' Lagrange.eval_interpolate_not_at_node'

end Nodal

end Lagrange