/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Sean Leather
-/
import data.list.range
import data.list.perm

/-!
# Utilities for lists of sigmas

This file includes several ways of interacting with `list (sigma β)`, treated as a key-value store.

If `α : Type*` and `β : α → Type*`, then we regard `s : sigma β` as having key `s.1 : α` and value
`s.2 : β s.1`. Hence, `list (sigma β)` behaves like a key-value store.

## Main Definitions

- `list.keys` extracts the list of keys.
- `list.nodupkeys` determines if the store has duplicate keys.
- `list.lookup`/`lookup_all` accesses the value(s) of a particular key.
- `list.kreplace` replaces the first value with a given key by a given value.
- `list.kerase` removes a value.
- `list.kinsert` inserts a value.
- `list.kunion` computes the union of two stores.
- `list.kextract` returns a value with a given key and the rest of the values.
-/

universes u v

namespace list
variables {α : Type u} {β : α → Type v} {l l₁ l₂ : list (sigma β)}

/-! ### `keys` -/

/-- List of keys from a list of key-value pairs -/
def keys : list (sigma β) → list α := map sigma.fst

@[simp] theorem keys_nil : @keys α β [] = [] := rfl

@[simp] theorem keys_cons {s} {l : list (sigma β)} : (s :: l).keys = s.1 :: l.keys := rfl

theorem mem_keys_of_mem {s : sigma β} {l : list (sigma β)} : s ∈ l → s.1 ∈ l.keys :=
mem_map_of_mem sigma.fst

theorem exists_of_mem_keys {a} {l : list (sigma β)} (h : a ∈ l.keys) :
  ∃ (b : β a), sigma.mk a b ∈ l :=
let ⟨⟨a', b'⟩, m, e⟩ := exists_of_mem_map h in
eq.rec_on e (exists.intro b' m)

theorem mem_keys {a} {l : list (sigma β)} : a ∈ l.keys ↔ ∃ (b : β a), sigma.mk a b ∈ l :=
⟨exists_of_mem_keys, λ ⟨b, h⟩, mem_keys_of_mem h⟩

theorem not_mem_keys {a} {l : list (sigma β)} : a ∉ l.keys ↔ ∀ b : β a, sigma.mk a b ∉ l :=
(not_iff_not_of_iff mem_keys).trans not_exists

theorem not_eq_key {a} {l : list (sigma β)} : a ∉ l.keys ↔ ∀ s : sigma β, s ∈ l → a ≠ s.1 :=
iff.intro
  (λ h₁ s h₂ e, absurd (mem_keys_of_mem h₂) (by rwa e at h₁))
  (λ f h₁, let ⟨b, h₂⟩ := exists_of_mem_keys h₁ in f _ h₂ rfl)

/-! ### `nodupkeys` -/

/-- Determines whether the store uses a key several times. -/
def nodupkeys (l : list (sigma β)) : Prop := l.keys.nodup

theorem nodupkeys_iff_pairwise {l} : nodupkeys l ↔
  pairwise (λ s s' : sigma β, s.1 ≠ s'.1) l := pairwise_map _

theorem nodupkeys.pairwise_ne {l} (h : nodupkeys l) :
  pairwise (λ s s' : sigma β, s.1 ≠ s'.1) l :=
nodupkeys_iff_pairwise.1 h

@[simp] theorem nodupkeys_nil : @nodupkeys α β [] := pairwise.nil

@[simp] theorem nodupkeys_cons {s : sigma β} {l : list (sigma β)} :
  nodupkeys (s::l) ↔ s.1 ∉ l.keys ∧ nodupkeys l :=
by simp [keys, nodupkeys]

theorem nodupkeys.eq_of_fst_eq {l : list (sigma β)}
  (nd : nodupkeys l) {s s' : sigma β} (h : s ∈ l) (h' : s' ∈ l) :
  s.1 = s'.1 → s = s' :=
@pairwise.forall_of_forall _
  (λ s s' : sigma β, s.1 = s'.1 → s = s') _
  (λ s s' H h, (H h.symm).symm) (λ x h _, rfl)
  ((nodupkeys_iff_pairwise.1 nd).imp (λ s s' h h', (h h').elim)) _ h _ h'

theorem nodupkeys.eq_of_mk_mem {a : α} {b b' : β a} {l : list (sigma β)}
  (nd : nodupkeys l) (h : sigma.mk a b ∈ l) (h' : sigma.mk a b' ∈ l) : b = b' :=
by cases nd.eq_of_fst_eq h h' rfl; refl

theorem nodupkeys_singleton (s : sigma β) : nodupkeys [s] := nodup_singleton _

theorem nodupkeys.sublist {l₁ l₂ : list (sigma β)} (h : l₁ <+ l₂) :
  nodupkeys l₂ → nodupkeys l₁ :=
nodup.sublist $ h.map _

protected lemma nodupkeys.nodup {l : list (sigma β)} : nodupkeys l → nodup l := nodup.of_map _

theorem perm_nodupkeys {l₁ l₂ : list (sigma β)} (h : l₁ ~ l₂) : nodupkeys l₁ ↔ nodupkeys l₂ :=
(h.map _).nodup_iff

theorem nodupkeys_join {L : list (list (sigma β))} :
  nodupkeys (join L) ↔ (∀ l ∈ L, nodupkeys l) ∧ pairwise disjoint (L.map keys) :=
begin
  rw [nodupkeys_iff_pairwise, pairwise_join, pairwise_map],
  refine and_congr (ball_congr $ λ l h, by simp [nodupkeys_iff_pairwise]) _,
  apply iff_of_eq, congr' with l₁ l₂,
  simp [keys, disjoint_iff_ne]
end

theorem nodup_enum_map_fst (l : list α) : (l.enum.map prod.fst).nodup :=
by simp [list.nodup_range]

lemma mem_ext {l₀ l₁ : list (sigma β)}
  (nd₀ : l₀.nodup) (nd₁ : l₁.nodup)
  (h : ∀ x, x ∈ l₀ ↔ x ∈ l₁) : l₀ ~ l₁ :=
begin
  induction l₀ with x xs generalizing l₁; cases l₁ with y ys,
  { constructor },
  iterate 2
  { specialize h x <|> specialize h y, simp at h,
    cases h },
  simp at nd₀ nd₁, classical,
  obtain rfl | h' := eq_or_ne x y,
  { constructor,
    refine l₀_ih nd₀.2 nd₁.2 (λ a, _),
    specialize h a, simp at h,
    obtain rfl | h' := eq_or_ne a x,
    { exact iff_of_false nd₀.1 nd₁.1 },
    { simpa [h'] using h } },
  { transitivity x :: y :: ys.erase x,
    { constructor,
      refine l₀_ih nd₀.2 ((nd₁.2.erase _).cons $ λ h, nd₁.1 $ mem_of_mem_erase h) (λ a, _),
      { specialize h a, simp at h,
        obtain rfl | h' := eq_or_ne a x,
        { exact iff_of_false nd₀.1 (λ h, h.elim h' nd₁.2.not_mem_erase) },
        { rw or_iff_right h' at h,
          rw [h, mem_cons_iff],
          exact or_congr_right' (mem_erase_of_ne h').symm } } },
    transitivity y :: x :: ys.erase x,
    { constructor },
    { constructor, symmetry, apply perm_cons_erase,
      specialize h x, simp [h'] at h, exact h } }
end

variables [decidable_eq α]

/-! ### `lookup` -/

/-- `lookup a l` is the first value in `l` corresponding to the key `a`,
  or `none` if no such element exists. -/
def lookup (a : α) : list (sigma β) → option (β a)
| []             := none
| (⟨a', b⟩ :: l) := if h : a' = a then some (eq.rec_on h b) else lookup l

@[simp] theorem lookup_nil (a : α) : lookup a [] = @none (β a) := rfl

@[simp] theorem lookup_cons_eq (l) (a : α) (b : β a) : lookup a (⟨a, b⟩::l) = some b :=
dif_pos rfl

@[simp] theorem lookup_cons_ne (l) {a} :
  ∀ s : sigma β, a ≠ s.1 → lookup a (s::l) = lookup a l
| ⟨a', b⟩ h := dif_neg h.symm

theorem lookup_is_some {a : α} : ∀ {l : list (sigma β)},
  (lookup a l).is_some ↔ a ∈ l.keys
| []             := by simp
| (⟨a', b⟩ :: l) := begin
  by_cases h : a = a',
  { subst a', simp },
  { simp [h, lookup_is_some] },
end

theorem lookup_eq_none {a : α} {l : list (sigma β)} :
  lookup a l = none ↔ a ∉ l.keys :=
by simp [← lookup_is_some, option.is_none_iff_eq_none]

theorem of_mem_lookup
  {a : α} {b : β a} : ∀ {l : list (sigma β)}, b ∈ lookup a l → sigma.mk a b ∈ l
| (⟨a', b'⟩ :: l) H := begin
  by_cases h : a = a',
  { subst a', simp at H, simp [H] },
  { simp [h] at H, exact or.inr (of_mem_lookup H) }
end

theorem mem_lookup {a} {b : β a} {l : list (sigma β)} (nd : l.nodupkeys)
  (h : sigma.mk a b ∈ l) : b ∈ lookup a l :=
begin
  cases option.is_some_iff_exists.mp (lookup_is_some.mpr (mem_keys_of_mem h)) with b' h',
  cases nd.eq_of_mk_mem h (of_mem_lookup h'),
  exact h'
end

theorem map_lookup_eq_find (a : α) : ∀ l : list (sigma β),
  (lookup a l).map (sigma.mk a) = find (λ s, a = s.1) l
| [] := rfl
| (⟨a', b'⟩ :: l) := begin
  by_cases h : a = a',
  { subst a', simp },
  { simp [h, map_lookup_eq_find] }
end

theorem mem_lookup_iff {a : α} {b : β a} {l : list (sigma β)} (nd : l.nodupkeys) :
  b ∈ lookup a l ↔ sigma.mk a b ∈ l :=
⟨of_mem_lookup, mem_lookup nd⟩

theorem perm_lookup (a : α) {l₁ l₂ : list (sigma β)}
  (nd₁ : l₁.nodupkeys) (nd₂ : l₂.nodupkeys) (p : l₁ ~ l₂) : lookup a l₁ = lookup a l₂ :=
by ext b; simp [mem_lookup_iff, nd₁, nd₂]; exact p.mem_iff

lemma lookup_ext {l₀ l₁ : list (sigma β)}
  (nd₀ : l₀.nodupkeys) (nd₁ : l₁.nodupkeys)
  (h : ∀ x y, y ∈ l₀.lookup x ↔ y ∈ l₁.lookup x) : l₀ ~ l₁ :=
mem_ext nd₀.nodup nd₁.nodup (λ ⟨a,b⟩, by rw [← mem_lookup_iff, ← mem_lookup_iff, h]; assumption)

/-! ### `lookup_all` -/

/-- `lookup_all a l` is the list of all values in `l` corresponding to the key `a`. -/
def lookup_all (a : α) : list (sigma β) → list (β a)
| []             := []
| (⟨a', b⟩ :: l) := if h : a' = a then eq.rec_on h b :: lookup_all l else lookup_all l

@[simp]

@[simp] theorem lookup_all_cons_eq (l) (a : α) (b : β a) :
  lookup_all a (⟨a, b⟩::l) = b :: lookup_all a l :=
dif_pos rfl

@[simp] theorem lookup_all_cons_ne (l) {a} :
  ∀ s : sigma β, a ≠ s.1 → lookup_all a (s::l) = lookup_all a l
| ⟨a', b⟩ h := dif_neg h.symm

theorem lookup_all_eq_nil {a : α} : ∀ {l : list (sigma β)},
  lookup_all a l = [] ↔ ∀ b : β a, sigma.mk a b ∉ l
| []             := by simp
| (⟨a', b⟩ :: l) := begin
  by_cases h : a = a',
  { subst a', simp },
  { simp [h, lookup_all_eq_nil] },
end

theorem head_lookup_all (a : α) : ∀ l : list (sigma β),
  head' (lookup_all a l) = lookup a l
| []             := by simp
| (⟨a', b⟩ :: l) := by by_cases h : a = a'; [{subst h, simp}, simp *]

theorem mem_lookup_all {a : α} {b : β a} :
  ∀ {l : list (sigma β)}, b ∈ lookup_all a l ↔ sigma.mk a b ∈ l
| []              := by simp
| (⟨a', b'⟩ :: l) := by by_cases h : a = a'; [{subst h, simp *}, simp *]

theorem lookup_all_sublist (a : α) :
  ∀ l : list (sigma β), (lookup_all a l).map (sigma.mk a) <+ l
| []              := by simp
| (⟨a', b'⟩ :: l) := begin
    by_cases h : a = a',
    { subst h, simp, exact (lookup_all_sublist l).cons2 _ _ _ },
    { simp [h], exact (lookup_all_sublist l).cons _ _ _ }
  end

theorem lookup_all_length_le_one (a : α) {l : list (sigma β)} (h : l.nodupkeys) :
  length (lookup_all a l) ≤ 1 :=
by have := nodup.sublist ((lookup_all_sublist a l).map _) h;
   rw map_map at this; rwa [← nodup_repeat, ← map_const _ a]

theorem lookup_all_eq_lookup (a : α) {l : list (sigma β)} (h : l.nodupkeys) :
  lookup_all a l = (lookup a l).to_list :=
begin
  rw ← head_lookup_all,
  have := lookup_all_length_le_one a h, revert this,
  rcases lookup_all a l with _|⟨b, _|⟨c, l⟩⟩; intro; try {refl},
  exact absurd this dec_trivial
end

theorem lookup_all_nodup (a : α) {l : list (sigma β)} (h : l.nodupkeys) :
  (lookup_all a l).nodup :=
by rw lookup_all_eq_lookup a h; apply option.to_list_nodup

theorem perm_lookup_all (a : α) {l₁ l₂ : list (sigma β)}
  (nd₁ : l₁.nodupkeys) (nd₂ : l₂.nodupkeys) (p : l₁ ~ l₂) : lookup_all a l₁ = lookup_all a l₂ :=
by simp [lookup_all_eq_lookup, nd₁, nd₂, perm_lookup a nd₁ nd₂ p]

/-! ### `kreplace` -/

/-- Replaces the first value with key `a` by `b`. -/
def kreplace (a : α) (b : β a) : list (sigma β) → list (sigma β) :=
lookmap $ λ s, if a = s.1 then some ⟨a, b⟩ else none

theorem kreplace_of_forall_not (a : α) (b : β a) {l : list (sigma β)}
  (H : ∀ b : β a, sigma.mk a b ∉ l) : kreplace a b l = l :=
lookmap_of_forall_not _ $ begin
  rintro ⟨a', b'⟩ h, dsimp, split_ifs,
  { subst a', exact H _ h }, {refl}
end

theorem kreplace_self {a : α} {b : β a} {l : list (sigma β)}
  (nd : nodupkeys l) (h : sigma.mk a b ∈ l) : kreplace a b l = l :=
begin
  refine (lookmap_congr _).trans
    (lookmap_id' (option.guard (λ s, a = s.1)) _ _),
  { rintro ⟨a', b'⟩ h', dsimp [option.guard], split_ifs,
    { subst a', exact ⟨rfl, heq_of_eq $ nd.eq_of_mk_mem h h'⟩ },
    { refl } },
  { rintro ⟨a₁, b₁⟩ ⟨a₂, b₂⟩, dsimp [option.guard], split_ifs,
    { subst a₁, rintro ⟨⟩, simp }, { rintro ⟨⟩ } },
end

theorem keys_kreplace (a : α) (b : β a) : ∀ l : list (sigma β),
  (kreplace a b l).keys = l.keys :=
lookmap_map_eq _ _ $ by rintro ⟨a₁, b₂⟩ ⟨a₂, b₂⟩;
  dsimp; split_ifs; simp [h] {contextual := tt}

theorem kreplace_nodupkeys (a : α) (b : β a) {l : list (sigma β)} :
  (kreplace a b l).nodupkeys ↔ l.nodupkeys :=
by simp [nodupkeys, keys_kreplace]

theorem perm.kreplace {a : α} {b : β a} {l₁ l₂ : list (sigma β)}
  (nd : l₁.nodupkeys) : l₁ ~ l₂ →
  kreplace a b l₁ ~ kreplace a b l₂ :=
perm_lookmap _ $ begin
  refine nd.pairwise_ne.imp _,
  intros x y h z h₁ w h₂,
  split_ifs at h₁ h₂; cases h₁; cases h₂,
  exact (h (h_2.symm.trans h_1)).elim
end

/-! ### `kerase` -/

/-- Remove the first pair with the key `a`. -/
def kerase (a : α) : list (sigma β) → list (sigma β) :=
erasep $ λ s, a = s.1

@[simp] theorem kerase_nil {a} : @kerase _ β _ a [] = [] :=
rfl

@[simp, priority 990]
theorem kerase_cons_eq {a} {s : sigma β} {l : list (sigma β)} (h : a = s.1) :
  kerase a (s :: l) = l :=
by simp [kerase, h]

@[simp, priority 990]
theorem kerase_cons_ne {a} {s : sigma β} {l : list (sigma β)} (h : a ≠ s.1) :
  kerase a (s :: l) = s :: kerase a l :=
by simp [kerase, h]

@[simp, priority 980]
theorem kerase_of_not_mem_keys {a} {l : list (sigma β)} (h : a ∉ l.keys) :
  kerase a l = l :=
by induction l with _ _ ih;
   [refl, { simp [not_or_distrib] at h, simp [h.1, ih h.2] }]

theorem kerase_sublist (a : α) (l : list (sigma β)) : kerase a l <+ l :=
erasep_sublist _

theorem kerase_keys_subset (a) (l : list (sigma β)) :
  (kerase a l).keys ⊆ l.keys :=
((kerase_sublist a l).map _).subset

theorem mem_keys_of_mem_keys_kerase {a₁ a₂} {l : list (sigma β)} :
  a₁ ∈ (kerase a₂ l).keys → a₁ ∈ l.keys :=
@kerase_keys_subset _ _ _ _ _ _

theorem exists_of_kerase {a : α} {l : list (sigma β)} (h : a ∈ l.keys) :
  ∃ (b : β a) (l₁ l₂ : list (sigma β)),
    a ∉ l₁.keys ∧
    l = l₁ ++ ⟨a, b⟩ :: l₂ ∧
    kerase a l = l₁ ++ l₂ :=
begin
  induction l,
  case list.nil { cases h },
  case list.cons : hd tl ih
  { by_cases e : a = hd.1,
    { subst e,
      exact ⟨hd.2, [], tl, by simp, by cases hd; refl, by simp⟩ },
    { simp at h,
      cases h,
      case or.inl : h { exact absurd h e },
      case or.inr : h
      { rcases ih h with ⟨b, tl₁, tl₂, h₁, h₂, h₃⟩,
        exact ⟨b, hd :: tl₁, tl₂, not_mem_cons_of_ne_of_not_mem e h₁,
               by rw h₂; refl, by simp [e, h₃]⟩ } } }
end

@[simp, priority 990]
theorem mem_keys_kerase_of_ne {a₁ a₂} {l : list (sigma β)} (h : a₁ ≠ a₂) :
  a₁ ∈ (kerase a₂ l).keys ↔ a₁ ∈ l.keys :=
iff.intro mem_keys_of_mem_keys_kerase $ λ p,
  if q : a₂ ∈ l.keys then
    match l, kerase a₂ l, exists_of_kerase q, p with
    | _, _, ⟨_, _, _, _, rfl, rfl⟩, p := by simpa [keys, h] using p
    end
  else
    by simp [q, p]

theorem keys_kerase {a} {l : list (sigma β)} : (kerase a l).keys = l.keys.erase a :=
by rw [keys, kerase, ←erasep_map sigma.fst l, erase_eq_erasep]

theorem kerase_kerase {a a'} {l : list (sigma β)} :
  (kerase a' l).kerase a = (kerase a l).kerase a' :=
begin
  by_cases a = a',
  { subst a' },
  induction l with x xs, { refl },
  { by_cases a' = x.1,
    { subst a', simp [kerase_cons_ne h,kerase_cons_eq rfl] },
    by_cases h' : a = x.1,
    { subst a, simp [kerase_cons_eq rfl,kerase_cons_ne (ne.symm h)] },
    { simp [kerase_cons_ne,*] } }
end

lemma nodupkeys.kerase (a : α) : nodupkeys l → (kerase a l).nodupkeys :=
nodupkeys.sublist $ kerase_sublist _ _

theorem perm.kerase {a : α} {l₁ l₂ : list (sigma β)}
  (nd : l₁.nodupkeys) : l₁ ~ l₂ → kerase a l₁ ~ kerase a l₂ :=
perm.erasep _ $ (nodupkeys_iff_pairwise.1 nd).imp $
by rintro x y h rfl; exact h

@[simp] theorem not_mem_keys_kerase (a) {l : list (sigma β)} (nd : l.nodupkeys) :
  a ∉ (kerase a l).keys :=
begin
  induction l,
  case list.nil { simp },
  case list.cons : hd tl ih
  { simp at nd,
    by_cases h : a = hd.1,
    { subst h, simp [nd.1] },
    { simp [h, ih nd.2] } }
end

@[simp] theorem lookup_kerase (a) {l : list (sigma β)} (nd : l.nodupkeys) :
  lookup a (kerase a l) = none :=
lookup_eq_none.mpr (not_mem_keys_kerase a nd)

@[simp] theorem lookup_kerase_ne {a a'} {l : list (sigma β)} (h : a ≠ a') :
  lookup a (kerase a' l) = lookup a l :=
begin
  induction l,
  case list.nil { refl },
  case list.cons : hd tl ih
  { cases hd with ah bh,
    by_cases h₁ : a = ah; by_cases h₂ : a' = ah,
    { substs h₁ h₂, cases ne.irrefl h },
    { subst h₁, simp [h₂] },
    { subst h₂, simp [h] },
    { simp [h₁, h₂, ih] } }
end

theorem kerase_append_left {a} : ∀ {l₁ l₂ : list (sigma β)},
  a ∈ l₁.keys → kerase a (l₁ ++ l₂) = kerase a l₁ ++ l₂
| []        _  h  := by cases h
| (s :: l₁) l₂ h₁ :=
  if h₂ : a = s.1 then
    by simp [h₂]
  else
    by simp at h₁;
       cases h₁;
       [exact absurd h₁ h₂, simp [h₂, kerase_append_left h₁]]

theorem kerase_append_right {a} : ∀ {l₁ l₂ : list (sigma β)},
  a ∉ l₁.keys → kerase a (l₁ ++ l₂) = l₁ ++ kerase a l₂
| []        _  h := rfl
| (_ :: l₁) l₂ h := by simp [not_or_distrib] at h;
                       simp [h.1, kerase_append_right h.2]

theorem kerase_comm (a₁ a₂) (l : list (sigma β)) :
  kerase a₂ (kerase a₁ l) = kerase a₁ (kerase a₂ l) :=
if h : a₁ = a₂ then
  by simp [h]
else if ha₁ : a₁ ∈ l.keys then
  if ha₂ : a₂ ∈ l.keys then
    match l, kerase a₁ l, exists_of_kerase ha₁, ha₂ with
    | _, _, ⟨b₁, l₁, l₂, a₁_nin_l₁, rfl, rfl⟩, a₂_in_l₁_app_l₂ :=
      if h' : a₂ ∈ l₁.keys then
        by simp [kerase_append_left h',
                 kerase_append_right (mt (mem_keys_kerase_of_ne h).mp a₁_nin_l₁)]
      else
        by simp [kerase_append_right h', kerase_append_right a₁_nin_l₁,
                 @kerase_cons_ne _ _ _ a₂ ⟨a₁, b₁⟩ _ (ne.symm h)]
    end
  else
    by simp [ha₂, mt mem_keys_of_mem_keys_kerase ha₂]
else
  by simp [ha₁, mt mem_keys_of_mem_keys_kerase ha₁]

lemma sizeof_kerase {α} {β : α → Type*} [decidable_eq α] [has_sizeof (sigma β)] (x : α)
  (xs : list (sigma β)) :
  sizeof (list.kerase x xs) ≤ sizeof xs :=
begin
  unfold_wf,
  induction xs with y ys,
  { simp },
  { by_cases x = y.1; simp [*, list.sizeof] },
end

/-! ### `kinsert` -/

/-- Insert the pair `⟨a, b⟩` and erase the first pair with the key `a`. -/
def kinsert (a : α) (b : β a) (l : list (sigma β)) : list (sigma β) :=
⟨a, b⟩ :: kerase a l

@[simp] theorem kinsert_def {a} {b : β a} {l : list (sigma β)} :
  kinsert a b l = ⟨a, b⟩ :: kerase a l := rfl

theorem mem_keys_kinsert {a a'} {b' : β a'} {l : list (sigma β)} :
  a ∈ (kinsert a' b' l).keys ↔ a = a' ∨ a ∈ l.keys :=
by by_cases h : a = a'; simp [h]

theorem kinsert_nodupkeys (a) (b : β a) {l : list (sigma β)} (nd : l.nodupkeys) :
  (kinsert a b l).nodupkeys :=
nodupkeys_cons.mpr ⟨not_mem_keys_kerase a nd, nd.kerase a⟩

theorem perm.kinsert {a} {b : β a} {l₁ l₂ : list (sigma β)} (nd₁ : l₁.nodupkeys)
  (p : l₁ ~ l₂) : kinsert a b l₁ ~ kinsert a b l₂ :=
(p.kerase nd₁).cons _

theorem lookup_kinsert {a} {b : β a} (l : list (sigma β)) :
  lookup a (kinsert a b l) = some b :=
by simp only [kinsert, lookup_cons_eq]

theorem lookup_kinsert_ne {a a'} {b' : β a'} {l : list (sigma β)} (h : a ≠ a') :
  lookup a (kinsert a' b' l) = lookup a l :=
by simp [h]

/-! ### `kextract` -/

/-- Finds the first entry with a given key `a` and returns its value (as an `option` because there
might be no entry with key `a`) alongside with the rest of the entries. -/
def kextract (a : α) : list (sigma β) → option (β a) × list (sigma β)
| []     := (none, [])
| (s::l) := if h : s.1 = a then (some (eq.rec_on h s.2), l) else
  let (b', l') := kextract l in (b', s :: l')

@[simp] theorem kextract_eq_lookup_kerase (a : α) :
  ∀ l : list (sigma β), kextract a l = (lookup a l, kerase a l)
| []     := rfl
| (⟨a', b⟩::l) := begin
    simp [kextract], dsimp, split_ifs,
    { subst a', simp [kerase] },
    { simp [kextract, ne.symm h, kextract_eq_lookup_kerase l, kerase] }
  end

/-! ### `dedupkeys` -/

/-- Remove entries with duplicate keys from `l : list (sigma β)`. -/
def dedupkeys : list (sigma β) → list (sigma β) :=
list.foldr (λ x, kinsert x.1 x.2) []

lemma dedupkeys_cons {x : sigma β} (l : list (sigma β)) :
  dedupkeys (x :: l) = kinsert x.1 x.2 (dedupkeys l) := rfl

lemma nodupkeys_dedupkeys (l : list (sigma β)) : nodupkeys (dedupkeys l) :=
begin
  dsimp [dedupkeys], generalize hl : nil = l',
  have : nodupkeys l', { rw ← hl, apply nodup_nil },
  clear hl,
  induction l with x xs,
  { apply this },
  { cases x, simp [dedupkeys], split,
    { simp [keys_kerase], apply l_ih.not_mem_erase },
    { exact l_ih.kerase _ } }
end

lemma lookup_dedupkeys (a : α) (l : list (sigma β)) : lookup a (dedupkeys l) = lookup a l :=
begin
  induction l, refl,
  cases l_hd with a' b,
  by_cases a = a',
  { subst a', rw [dedupkeys_cons,lookup_kinsert,lookup_cons_eq] },
  { rw [dedupkeys_cons,lookup_kinsert_ne h,l_ih,lookup_cons_ne], exact h },
end

lemma sizeof_dedupkeys {α} {β : α → Type*} [decidable_eq α] [has_sizeof (sigma β)]
  (xs : list (sigma β)) :
  sizeof (list.dedupkeys xs) ≤ sizeof xs :=
begin
  unfold_wf,
  induction xs with x xs,
  { simp [list.dedupkeys] },
  { simp only [dedupkeys_cons, list.sizeof, kinsert_def, add_le_add_iff_left, sigma.eta],
    transitivity, apply sizeof_kerase,
    assumption }
end

/-! ### `kunion` -/

/-- `kunion l₁ l₂` is the append to l₁ of l₂ after, for each key in l₁, the
first matching pair in l₂ is erased. -/
def kunion : list (sigma β) → list (sigma β) → list (sigma β)
| []        l₂ := l₂
| (s :: l₁) l₂ := s :: kunion l₁ (kerase s.1 l₂)

@[simp] theorem nil_kunion {l : list (sigma β)} : kunion [] l = l :=
rfl

@[simp] theorem kunion_nil : ∀ {l : list (sigma β)}, kunion l [] = l
| []       := rfl
| (_ :: l) := by rw [kunion, kerase_nil, kunion_nil]

@[simp] theorem kunion_cons {s} {l₁ l₂ : list (sigma β)} :
  kunion (s :: l₁) l₂ = s :: kunion l₁ (kerase s.1 l₂) :=
rfl

@[simp] theorem mem_keys_kunion {a} {l₁ l₂ : list (sigma β)} :
  a ∈ (kunion l₁ l₂).keys ↔ a ∈ l₁.keys ∨ a ∈ l₂.keys :=
begin
  induction l₁ generalizing l₂,
  case list.nil { simp },
  case list.cons : s l₁ ih { by_cases h : a = s.1; [simp [h], simp [h, ih]] }
end

@[simp] theorem kunion_kerase {a} : ∀ {l₁ l₂ : list (sigma β)},
  kunion (kerase a l₁) (kerase a l₂) = kerase a (kunion l₁ l₂)
| []       _ := rfl
| (s :: _) l := by by_cases h : a = s.1;
                   simp [h, kerase_comm a s.1 l, kunion_kerase]

lemma nodupkeys.kunion
  (nd₁ : l₁.nodupkeys) (nd₂ : l₂.nodupkeys) : (kunion l₁ l₂).nodupkeys :=
begin
  induction l₁ generalizing l₂,
  case list.nil { simp only [nil_kunion, nd₂] },
  case list.cons : s l₁ ih
  { simp at nd₁,
    simp [not_or_distrib, nd₁.1, nd₂, ih nd₁.2 (nd₂.kerase s.1)] }
end

theorem perm.kunion_right {l₁ l₂ : list (sigma β)} (p : l₁ ~ l₂) (l) :
  kunion l₁ l ~ kunion l₂ l :=
begin
  induction p generalizing l,
  case list.perm.nil { refl },
  case list.perm.cons : hd tl₁ tl₂ p ih
  { simp [ih (kerase hd.1 l), perm.cons] },
  case list.perm.swap : s₁ s₂ l
  { simp [kerase_comm, perm.swap] },
  case list.perm.trans : l₁ l₂ l₃ p₁₂ p₂₃ ih₁₂ ih₂₃
  { exact perm.trans (ih₁₂ l) (ih₂₃ l) }
end

theorem perm.kunion_left : ∀ l {l₁ l₂ : list (sigma β)},
  l₁.nodupkeys → l₁ ~ l₂ → kunion l l₁ ~ kunion l l₂
| []       _  _  _   p := p
| (s :: l) l₁ l₂ nd₁ p :=
  by simp [((p.kerase nd₁).kunion_left l $ nd₁.kerase s.1).cons s]

theorem perm.kunion {l₁ l₂ l₃ l₄ : list (sigma β)} (nd₃ : l₃.nodupkeys)
  (p₁₂ : l₁ ~ l₂) (p₃₄ : l₃ ~ l₄) : kunion l₁ l₃ ~ kunion l₂ l₄ :=
(p₁₂.kunion_right l₃).trans (p₃₄.kunion_left l₂ nd₃)

@[simp] theorem lookup_kunion_left {a} {l₁ l₂ : list (sigma β)} (h : a ∈ l₁.keys) :
  lookup a (kunion l₁ l₂) = lookup a l₁ :=
begin
  induction l₁ with s _ ih generalizing l₂; simp at h; cases h; cases s with a',
  { subst h, simp },
  { rw kunion_cons,
    by_cases h' : a = a',
    { subst h', simp },
    { simp [h', ih h] } }
end

@[simp] theorem lookup_kunion_right {a} {l₁ l₂ : list (sigma β)} (h : a ∉ l₁.keys) :
  lookup a (kunion l₁ l₂) = lookup a l₂ :=
begin
  induction l₁ generalizing l₂,
  case list.nil { simp },
  case list.cons : _ _ ih { simp [not_or_distrib] at h, simp [h.1, ih h.2] }
end

@[simp] theorem mem_lookup_kunion {a} {b : β a} {l₁ l₂ : list (sigma β)} :
  b ∈ lookup a (kunion l₁ l₂) ↔ b ∈ lookup a l₁ ∨ a ∉ l₁.keys ∧ b ∈ lookup a l₂ :=
begin
  induction l₁ generalizing l₂,
  case list.nil { simp },
  case list.cons : s _ ih
  { cases s with a',
    by_cases h₁ : a = a',
    { subst h₁, simp },
    { let h₂ := @ih (kerase a' l₂), simp [h₁] at h₂, simp [h₁, h₂] } }
end

theorem mem_lookup_kunion_middle {a} {b : β a} {l₁ l₂ l₃ : list (sigma β)}
  (h₁ : b ∈ lookup a (kunion l₁ l₃)) (h₂ : a ∉ keys l₂) :
  b ∈ lookup a (kunion (kunion l₁ l₂) l₃) :=
match mem_lookup_kunion.mp h₁ with
| or.inl h := mem_lookup_kunion.mpr (or.inl (mem_lookup_kunion.mpr (or.inl h)))
| or.inr h := mem_lookup_kunion.mpr $
  or.inr ⟨mt mem_keys_kunion.mp (not_or_distrib.mpr ⟨h.1, h₂⟩), h.2⟩
end

end list


/-
Copyright (c) 2022 Mario Carneiro, Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Heather Macbeth, Yaël Dillies

! This file was ported from Lean 3 source module tactic.positivity
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.NormNum
import Mathbin.Algebra.Order.Field.Power
import Mathbin.Algebra.Order.Hom.Basic
import Mathbin.Data.Nat.Factorial.Basic

/-! # `positivity` tactic

The `positivity` tactic in this file solves goals of the form `0 ≤ x`, `0 < x` and `x ≠ 0`.  The
tactic works recursively according to the syntax of the expression `x`.  For example, a goal of the
form `0 ≤ 3 * a ^ 2 + b * c` can be solved either
* by a hypothesis such as `5 ≤ 3 * a ^ 2 + b * c` which directly implies the nonegativity of
  `3 * a ^ 2 + b * c`; or,
* by the application of the lemma `add_nonneg` and the success of the `positivity` tactic on the two
  sub-expressions `3 * a ^ 2` and `b * c`.

For each supported operation, one must write a small tactic, tagged with the attribute
`@[positivity]`, which operates only on goals whose leading function application is that operation.
Typically, this small tactic will run the full `positivity` tactic on one or more of the function's
arguments (which is where the recursion comes in), and if successful will combine this with an
appropriate lemma to give positivity of the full expression.

This file contains the core `positivity` logic and the small tactics handling the basic operations:
`min`, `max`, `+`, `*`, `/`, `⁻¹`, raising to natural powers, and taking absolute values.  Further
extensions, e.g. to handle `real.sqrt` and norms, can be found in the files of the library which
introduce these operations.

## Main declarations

* `tactic.norm_num.positivity` tries to prove positivity of an expression by running `norm_num` on
  it.  This is one of the base cases of the recursion.
* `tactic.positivity.compare_hyp` tries to prove positivity of an expression by comparing with a
  provided hypothesis.  If the hypothesis is of the form `a ≤ b` or similar, with `b` matching the
  expression whose proof of positivity is desired, then it will check whether `a` can be proved
  positive via `tactic.norm_num.positivity` and if so apply a transitivity lemma.  This is the other
  base case of the recursion.
* `tactic.positivity.attr` creates the `positivity` user attribute for tagging the extension
  tactics handling specific operations, and specifies the behaviour for a single step of the
  recursion
* `tactic.positivity.core` collects the list of tactics with the `@[positivity]` attribute and
  calls the first recursion step as specified in `tactic.positivity.attr`.  Its input is `e : expr`
  and its output (if it succeeds) is a term of a custom inductive type
  `tactic.positivity.strictness`, containing an `expr` which is a proof of the
  strict-positivity/nonnegativity of `e` as well as an indication of whether what could be proved
  was strict-positivity or nonnegativity
* `tactic.positivity.order_rel` is a custom inductive type recording whether the goal is
  `0 ≤ e`/`e ≥ 0`, `0 < e`/`e > 0`, `e ≠ 0` or `0 ≠ e`.
* `tactic.interactive.positivity` is the user-facing tactic.  It parses the goal and, if it is of
  one of the forms `0 ≤ e`, `0 < e`, `e > 0`, `e ≥ 0`, `e ≠ 0`, `0 ≠ e`, it sends `e` to
  `tactic.positivity.core`.

## TODO

Implement extensions for other operations (raising to non-numeral powers, `log`).
-/

namespace Tactic

/-- Inductive type recording either `positive` and an expression (typically a proof of a fact
`0 < x`) or `nonnegative` and an expression (typically a proof of a fact `0 ≤ x`). -/
unsafe inductive positivity.strictness : Type
  | positive : expr → positivity.strictness
  | nonnegative : expr → positivity.strictness
  | nonzero : expr → positivity.strictness
  deriving DecidableEq
#align tactic.positivity.strictness tactic.positivity.strictness

export Positivity.Strictness (positive nonnegative nonzero)

unsafe instance : ToString strictness :=
  ⟨fun s =>
    match s with
    | positive p => "strictness.positive (" ++ toString p ++ ")"
    | nonnegative p => "strictness.nonnegative (" ++ toString p ++ ")"
    | nonzero p => "strictness.nonzero (" ++ toString p ++ ")"⟩

unsafe instance : has_to_format strictness :=
  ⟨fun s => toString s⟩

private theorem lt_of_eq_of_lt'' {α} [Preorder α] {b b' a : α} : b = b' → a < b' → a < b :=
  fun h1 h2 => lt_of_lt_of_eq h2 h1.symm
#align tactic.lt_of_eq_of_lt'' tactic.lt_of_eq_of_lt''

/-- First base case of the `positivity` tactic.  We try `norm_num` to prove directly that an
expression `e` is positive, nonnegative or non-zero. -/
unsafe def norm_num.positivity (e : expr) : tactic strictness := do
  let (e', p) ← norm_num.derive e <|> refl_conv e
  let e'' ← e'.to_rat
  let typ ← infer_type e'
  let ic ← mk_instance_cache typ
  if e'' > 0 then do
      let (ic, p₁) ← norm_num.prove_pos ic e'
      positive <$> mk_app `` lt_of_eq_of_lt'' [p, p₁]
    else
      if e'' = 0 then nonnegative <$> mk_app `` ge_of_eq [p]
      else do
        let (ic, p₁) ← norm_num.prove_ne_zero' ic e'
        nonzero <$> to_expr ``(ne_of_eq_of_ne $(p) $(p₁))
#align tactic.norm_num.positivity tactic.norm_num.positivity

/-- Second base case of the `positivity` tactic: Any element of a canonically ordered additive
monoid is nonnegative. -/
unsafe def positivity_canon : expr → tactic strictness
  | q($(a)) => nonnegative <$> mk_app `` zero_le [a]
#align tactic.positivity_canon tactic.positivity_canon

namespace Positivity

/-- Inductive type recording whether the goal `positivity` is called on is nonnegativity, positivity
or different from `0`. -/
inductive OrderRel : Type
  | le : order_rel-- `0 ≤ a`

  | lt : order_rel-- `0 < a`

  | Ne : order_rel-- `a ≠ 0`

  | ne' : order_rel
  deriving Inhabited
#align tactic.positivity.order_rel Tactic.Positivity.OrderRel

-- `0 ≠ a`
unsafe instance : has_to_format OrderRel :=
  ⟨fun r =>
    match r with
    | order_rel.le => "order_rel.le"
    | order_rel.lt => "order_rel.lt"
    | order_rel.ne => "order_rel.ne"
    | order_rel.ne' => "order_rel.ne'"⟩

/-- Given two tactics whose result is `strictness`, report a `strictness`:
- if at least one gives `positive`, report `positive` and one of the expressions giving a proof of
  positivity
- if one reports `nonnegative` and the other reports `nonzero`, report `positive`
- else if at least one reports `nonnegative`, report `nonnegative` and one of the
  expressions giving a proof of nonnegativity
- else if at least one reports `nonzero`, report `nonzero` and one of the expressions giving a proof
  of nonzeroness
- if both fail, fail -/
protected unsafe def orelse (tac1 tac2 : tactic strictness) : tactic strictness := do
  let res1 ← try_core tac1
  match res1 with
    | none => tac2
    | some p1@(positive _) => pure p1
    | some (nonnegative e1) => do
      let res2 ← try_core tac2
      match res2 with
        | some p2@(positive _) => pure p2
        | some (nonzero e2) => positive <$> mk_app `` lt_of_le_of_ne' [e1, e2]
        | _ => pure (nonnegative e1)
    | some (nonzero e1) => do
      let res2 ← try_core tac2
      match res2 with
        | some p2@(positive _) => pure p2
        | some (nonnegative e2) => positive <$> mk_app `` lt_of_le_of_ne' [e2, e1]
        | _ => pure (nonzero e1)
#align tactic.positivity.orelse tactic.positivity.orelse

-- mathport name: «expr ≤|≥ »
scoped[Positivity] infixr:2 " ≤|≥ " => tactic.positivity.orelse

/-- This tactic fails with a message saying that `positivity` couldn't prove anything about `e`
if we only know that `a` and `b` are positive/nonnegative/nonzero (according to `pa` and `pb`). -/
unsafe def positivity_fail {α : Type _} (e a b : expr) (pa pb : strictness) : tactic α := do
  let e' ← pp e
  let a' ← pp a
  let b' ← pp b
  let f : strictness → format → format := fun p c =>
    match p with
    | positive _ => "0 < " ++ c
    | nonnegative _ => "0 ≤ " ++ c
    | nonzero _ => c ++ " ≠ 0"
  fail
      (↑"`positivity` can't say anything about `" ++ e' ++ "` knowing only `" ++ f pa a' ++
            "` and `" ++
          f pb b' ++
        "`")
#align tactic.positivity.positivity_fail tactic.positivity.positivity_fail

/-! ### Core logic of the `positivity` tactic -/

private theorem ne_of_ne_of_eq' {α : Type _} {a b c : α} (ha : a ≠ c) (h : a = b) : b ≠ c := by
  rwa [← h]
#align tactic.positivity.ne_of_ne_of_eq' tactic.positivity.ne_of_ne_of_eq'

/-- Calls `norm_num` on `a` to prove positivity/nonnegativity of `e` assuming `b` is defeq to `e`
and `p₂ : a ≤ b`. -/
unsafe def compare_hyp_le (e a b p₂ : expr) : tactic strictness := do
  is_def_eq e b
  let strict_a ← norm_num.positivity a
  match strict_a with
    | positive p₁ => positive <$> mk_app `` lt_of_lt_of_le [p₁, p₂]
    | nonnegative p₁ => nonnegative <$> mk_app `` le_trans [p₁, p₂]
    | _ => do
      let e' ← pp e
      let p₂' ← pp p₂
      fail (↑"`norm_num` can't prove nonnegativity of " ++ e' ++ " using " ++ p₂')
#align tactic.positivity.compare_hyp_le tactic.positivity.compare_hyp_le

/-- Calls `norm_num` on `a` to prove positivity/nonnegativity of `e` assuming `b` is defeq to `e`
and `p₂ : a < b`. -/
unsafe def compare_hyp_lt (e a b p₂ : expr) : tactic strictness := do
  is_def_eq e b
  let strict_a ← norm_num.positivity a
  match strict_a with
    | positive p₁ => positive <$> mk_app `` lt_trans [p₁, p₂]
    | nonnegative p₁ => positive <$> mk_app `` lt_of_le_of_lt [p₁, p₂]
    | _ => do
      let e' ← pp e
      let p₂' ← pp p₂
      fail (↑"`norm_num` can't prove positivity of " ++ e' ++ " using " ++ p₂')
#align tactic.positivity.compare_hyp_lt tactic.positivity.compare_hyp_lt

/-- Calls `norm_num` on `a` to prove positivity/nonnegativity/nonzeroness of `e` assuming `b` is
defeq to `e` and `p₂ : a = b`. -/
unsafe def compare_hyp_eq (e a b p₂ : expr) : tactic strictness := do
  is_def_eq e b
  let strict_a ← norm_num.positivity a
  match strict_a with
    | positive p₁ => positive <$> mk_app `` lt_of_lt_of_eq [p₁, p₂]
    | nonnegative p₁ => nonnegative <$> mk_app `` le_of_le_of_eq [p₁, p₂]
    | nonzero p₁ => nonzero <$> to_expr ``(ne_of_ne_of_eq' $(p₁) $(p₂))
#align tactic.positivity.compare_hyp_eq tactic.positivity.compare_hyp_eq

/-- Calls `norm_num` on `a` to prove nonzeroness of `e` assuming `b` is defeq to `e` and
`p₂ : b ≠ a`. -/
unsafe def compare_hyp_ne (e a b p₂ : expr) : tactic strictness := do
  is_def_eq e b
  let (a', p₁) ← norm_num.derive a <|> refl_conv a
  let a'' ← a'.to_rat
  if a'' = 0 then nonzero <$> mk_mapp `` ne_of_ne_of_eq [none, none, none, none, p₂, p₁]
    else do
      let e' ← pp e
      let p₂' ← pp p₂
      let a' ← pp a
      fail
          (↑"`norm_num` can't prove non-zeroness of " ++ e' ++ " using " ++ p₂' ++ " because " ++
              a' ++
            " is non-zero")
#align tactic.positivity.compare_hyp_ne tactic.positivity.compare_hyp_ne

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Third base case of the `positivity` tactic.  Prove an expression `e` is
      positive/nonnegative/nonzero by finding a hypothesis of the form `a < e`, `a ≤ e` or `a = e` in
      which `a` can be proved positive/nonnegative/nonzero by `norm_num`. -/
    unsafe
  def
    compare_hyp
    ( e p₂ : expr ) : tactic strictness
    :=
      do
        let p_typ ← infer_type p₂
          match
            p_typ
            with
            | q( $ ( lo ) ≤ $ ( hi ) ) => compare_hyp_le e lo hi p₂
              | q( $ ( hi ) ≥ $ ( lo ) ) => compare_hyp_le e lo hi p₂
              | q( $ ( lo ) < $ ( hi ) ) => compare_hyp_lt e lo hi p₂
              | q( $ ( hi ) > $ ( lo ) ) => compare_hyp_lt e lo hi p₂
              |
                q( $ ( lo ) = $ ( hi ) )
                =>
                compare_hyp_eq e lo hi p₂
                  <|>
                  do let p₂' ← mk_app ` ` Eq.symm [ p₂ ] compare_hyp_eq e hi lo p₂'
              |
                q( $ ( hi ) ≠ $ ( lo ) )
                =>
                compare_hyp_ne e lo hi p₂
                  <|>
                  do
                    let p₂' ← mk_mapp ` ` Ne.symm [ none , none , none , p₂ ]
                      compare_hyp_ne e hi lo p₂'
              |
                e
                =>
                do
                  let p₂' ← pp p₂
                    fail ( p₂' ++ "is not of the form `a ≤ b`, `a < b`, `a = b` or `a ≠ b`" )
#align tactic.positivity.compare_hyp tactic.positivity.compare_hyp

/-- Attribute allowing a user to tag a tactic as an extension for `tactic.interactive.positivity`.
The main (recursive) step of this tactic is to try successively all the extensions tagged with this
attribute on the expression at hand, and also to try the two "base case" tactics
`tactic.norm_num.positivity`, `tactic.positivity.compare_hyp` on the expression at hand. -/
@[user_attribute]
unsafe def attr : user_attribute (expr → tactic strictness) Unit
    where
  Name := `positivity
  descr := "extensions handling particular operations for the `positivity` tactic"
  cache_cfg :=
    { mk_cache := fun ns => do
        let t ←
          ns.foldlM
              (fun (t : expr → tactic strictness) n => do
                let t' ← eval_expr (expr → tactic strictness) (expr.const n [])
                pure fun e => t' e ≤|≥ t e)
              fun _ => failed
        pure fun e =>
            -- run all the extensions on `e`
                t
                e ≤|≥-- directly try `norm_num` on `e`
                  norm_num.positivity
                  e ≤|≥-- try showing nonnegativity from canonicity of the order
                    -- loop over hypotheses and try to compare with `e`
                    positivity_canon
                    e ≤|≥
                  local_context >>=
                    List.foldl (fun tac h => tac ≤|≥ compare_hyp e h)
                      (fail "no applicable positivity extension found")
      dependencies := [] }
#align tactic.positivity.attr tactic.positivity.attr

/-- Look for a proof of positivity/nonnegativity of an expression `e`; if found, return the proof
together with a `strictness` stating whether the proof found was for strict positivity
(`positive p`), nonnegativity (`nonnegative p`), or nonzeroness (`nonzero p`). -/
unsafe def core (e : expr) : tactic strictness := do
  let f ← attr.get_cache
  f e <|> fail "failed to prove positivity/nonnegativity/nonzeroness"
#align tactic.positivity.core tactic.positivity.core

end Positivity

open Positivity

open Positivity

namespace Interactive

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Tactic solving goals of the form `0 ≤ x`, `0 < x` and `x ≠ 0`.  The tactic works recursively
      according to the syntax of the expression `x`, if the atoms composing the expression all have
      numeric lower bounds which can be proved positive/nonnegative/nonzero by `norm_num`.  This tactic
      either closes the goal or fails.

      Examples:
      ```
      example {a : ℤ} (ha : 3 < a) : 0 ≤ a ^ 3 + a := by positivity

      example {a : ℤ} (ha : 1 < a) : 0 < |(3:ℤ) + a| := by positivity

      example {b : ℤ} : 0 ≤ max (-3) (b ^ 2) := by positivity
      ```
      -/
    unsafe
  def
    positivity
    : tactic Unit
    :=
      focus1
        do
          let t ← target >>= instantiate_mvars
            let
              ( rel_desired , a )
                ←
                match
                  t
                  with
                  | q( 0 ≤ $ ( e ) ) => pure ( OrderRel.le , e )
                    | q( $ ( e ) ≥ 0 ) => pure ( OrderRel.le , e )
                    | q( 0 < $ ( e ) ) => pure ( OrderRel.lt , e )
                    | q( $ ( e ) > 0 ) => pure ( OrderRel.lt , e )
                    |
                      q( $ ( e₁ ) ≠ $ ( e₂ ) )
                      =>
                      do
                        match
                          e₂
                          with
                          | q( Zero.zero ) => pure ( order_rel.ne , e₁ )
                            |
                              _
                              =>
                              match
                                e₁
                                with
                                | q( Zero.zero ) => pure ( order_rel.ne' , e₂ )
                                  | _ => fail "not a positivity/nonnegativity/nonzeroness goal"
                    | _ => fail "not a positivity/nonnegativity/nonzeroness goal"
            let strictness_proved ← tactic.positivity.core a
            (
                match
                  rel_desired , strictness_proved
                  with
                  | order_rel.lt , positive p => pure p
                    |
                      order_rel.lt , nonnegative _
                      =>
                      fail
                        (
                          "failed to prove strict positivity, but it would be "
                            ++
                            "possible to prove nonnegativity if desired"
                          )
                    |
                      order_rel.lt , nonzero _
                      =>
                      fail
                        (
                          "failed to prove strict positivity, but it would be "
                            ++
                            "possible to prove nonzeroness if desired"
                          )
                    | order_rel.le , positive p => mk_app ` ` le_of_lt [ p ]
                    | order_rel.le , nonnegative p => pure p
                    |
                      order_rel.le , nonzero _
                      =>
                      fail
                        (
                          "failed to prove nonnegativity, but it would be "
                            ++
                            "possible to prove nonzeroness if desired"
                          )
                    | order_rel.ne , positive p => to_expr ` `( ne_of_gt $ ( p ) )
                    |
                      order_rel.ne , nonnegative _
                      =>
                      fail
                        (
                          "failed to prove nonzeroness, but it would be "
                            ++
                            "possible to prove nonnegativity if desired"
                          )
                    | order_rel.ne , nonzero p => pure p
                    | order_rel.ne' , positive p => to_expr ` `( ne_of_lt $ ( p ) )
                    |
                      order_rel.ne' , nonnegative _
                      =>
                      fail
                        (
                          "failed to prove nonzeroness, but it would be "
                            ++
                            "possible to prove nonnegativity if desired"
                          )
                    | order_rel.ne' , nonzero p => to_expr ` `( Ne.symm $ ( p ) )
                )
              >>=
              tactic.exact
#align tactic.interactive.positivity tactic.interactive.positivity

add_tactic_doc
  { Name := "positivity"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.positivity]
    tags := ["arithmetic", "monotonicity", "finishing"] }

end Interactive

variable {ι α R : Type _}

/-! ### `positivity` extensions for particular arithmetic operations -/

section LinearOrder

variable [LinearOrder R] {a b c : R}

private theorem le_min_of_lt_of_le (ha : a < b) (hb : a ≤ c) : a ≤ min b c :=
  le_min ha.le hb
#align tactic.le_min_of_lt_of_le tactic.le_min_of_lt_of_le

private theorem le_min_of_le_of_lt (ha : a ≤ b) (hb : a < c) : a ≤ min b c :=
  le_min ha hb.le
#align tactic.le_min_of_le_of_lt tactic.le_min_of_le_of_lt

private theorem min_ne (ha : a ≠ c) (hb : b ≠ c) : min a b ≠ c :=
  by
  rw [min_def]
  split_ifs <;> assumption
#align tactic.min_ne tactic.min_ne

private theorem min_ne_of_ne_of_lt (ha : a ≠ c) (hb : c < b) : min a b ≠ c :=
  min_ne ha hb.ne'
#align tactic.min_ne_of_ne_of_lt tactic.min_ne_of_ne_of_lt

private theorem min_ne_of_lt_of_ne (ha : c < a) (hb : b ≠ c) : min a b ≠ c :=
  min_ne ha.ne' hb
#align tactic.min_ne_of_lt_of_ne tactic.min_ne_of_lt_of_ne

private theorem max_ne (ha : a ≠ c) (hb : b ≠ c) : max a b ≠ c :=
  by
  rw [max_def]
  split_ifs <;> assumption
#align tactic.max_ne tactic.max_ne

end LinearOrder

/-- Extension for the `positivity` tactic: the `min` of two numbers is nonnegative if both are
nonnegative, and strictly positive if both are. -/
@[positivity]
unsafe def positivity_min : expr → tactic strictness
  | e@q(min $(a) $(b)) => do
    let strictness_a ← core a
    let strictness_b ← core b
    match strictness_a, strictness_b with
      | positive pa, positive pb => positive <$> mk_app `` lt_min [pa, pb]
      | positive pa, nonnegative pb => nonnegative <$> mk_app `` le_min_of_lt_of_le [pa, pb]
      | nonnegative pa, positive pb => nonnegative <$> mk_app `` le_min_of_le_of_lt [pa, pb]
      | nonnegative pa, nonnegative pb => nonnegative <$> mk_app `` le_min [pa, pb]
      | positive pa, nonzero pb => nonzero <$> to_expr ``(min_ne_of_lt_of_ne $(pa) $(pb))
      | nonzero pa, positive pb => nonzero <$> to_expr ``(min_ne_of_ne_of_lt $(pa) $(pb))
      | nonzero pa, nonzero pb => nonzero <$> to_expr ``(min_ne $(pa) $(pb))
      | sa@_, sb@_ => positivity_fail e a b sa sb
  | e => pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `min a b`"
#align tactic.positivity_min tactic.positivity_min

/-- Extension for the `positivity` tactic: the `max` of two numbers is nonnegative if at least one
is nonnegative, strictly positive if at least one is positive, and nonzero if both are nonzero. -/
@[positivity]
unsafe def positivity_max : expr → tactic strictness
  | q(max $(a) $(b)) => do
    let strictness_a ← try_core (core a)
    (-- If `a ≠ 0`, we might prove `max a b ≠ 0` if `b ≠ 0` but we don't want to evaluate
        -- `b` before having ruled out `0 < a`, for performance. So we do that in the second branch
        -- of the `orelse'`.
        do
          match strictness_a with
            | some (positive pa) =>
              positive <$> mk_mapp `` lt_max_of_lt_left [none, none, none, a, b, pa]
            | some (nonnegative pa) =>
              nonnegative <$> mk_mapp `` le_max_of_le_left [none, none, none, a, b, pa]
            | _ => failed) ≤|≥
        do
        let strictness_b ← core b
        match strictness_b with
          | positive pb => positive <$> mk_mapp `` lt_max_of_lt_right [none, none, none, a, b, pb]
          | nonnegative pb =>
            nonnegative <$> mk_mapp `` le_max_of_le_right [none, none, none, a, b, pb]
          | nonzero pb => do
            let nonzero pa ← strictness_a
            nonzero <$> to_expr ``(max_ne $(pa) $(pb))
  | e => pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `max a b`"
#align tactic.positivity_max tactic.positivity_max

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Extension for the `positivity` tactic: addition is nonnegative if both summands are nonnegative,
      and strictly positive if at least one summand is. -/
    @[ positivity ]
    unsafe
  def
    positivity_add
    : expr → tactic strictness
    |
        e @ q( $ ( a ) + $ ( b ) )
        =>
        do
          let strictness_a ← core a
            let strictness_b ← core b
            match
              strictness_a , strictness_b
              with
              | positive pa , positive pb => positive <$> mk_app ` ` add_pos [ pa , pb ]
                |
                  positive pa , nonnegative pb
                  =>
                  positive <$> mk_app ` ` lt_add_of_pos_of_le [ pa , pb ]
                |
                  nonnegative pa , positive pb
                  =>
                  positive <$> mk_app ` ` lt_add_of_le_of_pos [ pa , pb ]
                |
                  nonnegative pa , nonnegative pb
                  =>
                  nonnegative <$> mk_app ` ` add_nonneg [ pa , pb ]
                | sa @ _ , sb @ _ => positivity_fail e a b sa sb
      | e => pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `a + b`"
#align tactic.positivity_add tactic.positivity_add

section OrderedSemiring

variable [OrderedSemiring R] {a b : R}

private theorem mul_nonneg_of_pos_of_nonneg (ha : 0 < a) (hb : 0 ≤ b) : 0 ≤ a * b :=
  mul_nonneg ha.le hb
#align tactic.mul_nonneg_of_pos_of_nonneg tactic.mul_nonneg_of_pos_of_nonneg

private theorem mul_nonneg_of_nonneg_of_pos (ha : 0 ≤ a) (hb : 0 < b) : 0 ≤ a * b :=
  mul_nonneg ha hb.le
#align tactic.mul_nonneg_of_nonneg_of_pos tactic.mul_nonneg_of_nonneg_of_pos

private theorem mul_ne_zero_of_pos_of_ne_zero [NoZeroDivisors R] (ha : 0 < a) (hb : b ≠ 0) :
    a * b ≠ 0 :=
  mul_ne_zero ha.ne' hb
#align tactic.mul_ne_zero_of_pos_of_ne_zero tactic.mul_ne_zero_of_pos_of_ne_zero

private theorem mul_ne_zero_of_ne_zero_of_pos [NoZeroDivisors R] (ha : a ≠ 0) (hb : 0 < b) :
    a * b ≠ 0 :=
  mul_ne_zero ha hb.ne'
#align tactic.mul_ne_zero_of_ne_zero_of_pos tactic.mul_ne_zero_of_ne_zero_of_pos

end OrderedSemiring

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Extension for the `positivity` tactic: multiplication is nonnegative/positive/nonzero if both
      multiplicands are. -/
    @[ positivity ]
    unsafe
  def
    positivity_mul
    : expr → tactic strictness
    |
        e @ q( $ ( a ) * $ ( b ) )
        =>
        do
          let strictness_a ← core a
            let strictness_b ← core b
            match
              strictness_a , strictness_b
              with
              | positive pa , positive pb => positive <$> mk_app ` ` mul_pos [ pa , pb ]
                |
                  positive pa , nonnegative pb
                  =>
                  nonnegative <$> mk_app ` ` mul_nonneg_of_pos_of_nonneg [ pa , pb ]
                |
                  nonnegative pa , positive pb
                  =>
                  nonnegative <$> mk_app ` ` mul_nonneg_of_nonneg_of_pos [ pa , pb ]
                |
                  nonnegative pa , nonnegative pb
                  =>
                  nonnegative <$> mk_app ` ` mul_nonneg [ pa , pb ]
                |
                  positive pa , nonzero pb
                  =>
                  nonzero <$> to_expr ` `( mul_ne_zero_of_pos_of_ne_zero $ ( pa ) $ ( pb ) )
                |
                  nonzero pa , positive pb
                  =>
                  nonzero <$> to_expr ` `( mul_ne_zero_of_ne_zero_of_pos $ ( pa ) $ ( pb ) )
                |
                  nonzero pa , nonzero pb
                  =>
                  nonzero <$> to_expr ` `( mul_ne_zero $ ( pa ) $ ( pb ) )
                | sa @ _ , sb @ _ => positivity_fail e a b sa sb
      | e => pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `a * b`"
#align tactic.positivity_mul tactic.positivity_mul

section LinearOrderedSemifield

variable [LinearOrderedSemifield R] {a b : R}

private theorem div_nonneg_of_pos_of_nonneg (ha : 0 < a) (hb : 0 ≤ b) : 0 ≤ a / b :=
  div_nonneg ha.le hb
#align tactic.div_nonneg_of_pos_of_nonneg tactic.div_nonneg_of_pos_of_nonneg

private theorem div_nonneg_of_nonneg_of_pos (ha : 0 ≤ a) (hb : 0 < b) : 0 ≤ a / b :=
  div_nonneg ha hb.le
#align tactic.div_nonneg_of_nonneg_of_pos tactic.div_nonneg_of_nonneg_of_pos

private theorem div_ne_zero_of_pos_of_ne_zero (ha : 0 < a) (hb : b ≠ 0) : a / b ≠ 0 :=
  div_ne_zero ha.ne' hb
#align tactic.div_ne_zero_of_pos_of_ne_zero tactic.div_ne_zero_of_pos_of_ne_zero

private theorem div_ne_zero_of_ne_zero_of_pos (ha : a ≠ 0) (hb : 0 < b) : a / b ≠ 0 :=
  div_ne_zero ha hb.ne'
#align tactic.div_ne_zero_of_ne_zero_of_pos tactic.div_ne_zero_of_ne_zero_of_pos

end LinearOrderedSemifield

private theorem int_div_self_pos {a : ℤ} (ha : 0 < a) : 0 < a / a :=
  by
  rw [Int.ediv_self ha.ne']
  exact zero_lt_one
#align tactic.int_div_self_pos tactic.int_div_self_pos

private theorem int_div_nonneg_of_pos_of_nonneg {a b : ℤ} (ha : 0 < a) (hb : 0 ≤ b) : 0 ≤ a / b :=
  Int.div_nonneg ha.le hb
#align tactic.int_div_nonneg_of_pos_of_nonneg tactic.int_div_nonneg_of_pos_of_nonneg

private theorem int_div_nonneg_of_nonneg_of_pos {a b : ℤ} (ha : 0 ≤ a) (hb : 0 < b) : 0 ≤ a / b :=
  Int.div_nonneg ha hb.le
#align tactic.int_div_nonneg_of_nonneg_of_pos tactic.int_div_nonneg_of_nonneg_of_pos

private theorem int_div_nonneg_of_pos_of_pos {a b : ℤ} (ha : 0 < a) (hb : 0 < b) : 0 ≤ a / b :=
  Int.div_nonneg ha.le hb.le
#align tactic.int_div_nonneg_of_pos_of_pos tactic.int_div_nonneg_of_pos_of_pos

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Extension for the `positivity` tactic: division is nonnegative if both numerator and denominator
      are nonnegative, and strictly positive if both numerator and denominator are. -/
    @[ positivity ]
    unsafe
  def
    positivity_div
    : expr → tactic strictness
    |
        e @ q( @ Div.div ℤ _ $ ( a ) $ ( b ) )
        =>
        do
          let strictness_a ← core a
            let strictness_b ← core b
            match
              strictness_a , strictness_b
              with
              |
                  positive pa , positive pb
                  =>
                  if
                    a = b
                    then
                    positive <$> mk_app ` ` int_div_self_pos [ pa ]
                    else
                    nonnegative <$> mk_app ` ` int_div_nonneg_of_pos_of_pos [ pa , pb ]
                |
                  positive pa , nonnegative pb
                  =>
                  nonnegative <$> mk_app ` ` int_div_nonneg_of_pos_of_nonneg [ pa , pb ]
                |
                  nonnegative pa , positive pb
                  =>
                  nonnegative <$> mk_app ` ` int_div_nonneg_of_nonneg_of_pos [ pa , pb ]
                |
                  nonnegative pa , nonnegative pb
                  =>
                  nonnegative <$> mk_app ` ` Int.div_nonneg [ pa , pb ]
                | sa @ _ , sb @ _ => positivity_fail e a b sa sb
      |
        e @ q( $ ( a ) / $ ( b ) )
        =>
        do
          let strictness_a ← core a
            let strictness_b ← core b
            match
              strictness_a , strictness_b
              with
              | positive pa , positive pb => positive <$> mk_app ` ` div_pos [ pa , pb ]
                |
                  positive pa , nonnegative pb
                  =>
                  nonnegative <$> mk_app ` ` div_nonneg_of_pos_of_nonneg [ pa , pb ]
                |
                  nonnegative pa , positive pb
                  =>
                  nonnegative <$> mk_app ` ` div_nonneg_of_nonneg_of_pos [ pa , pb ]
                |
                  nonnegative pa , nonnegative pb
                  =>
                  nonnegative <$> mk_app ` ` div_nonneg [ pa , pb ]
                |
                  positive pa , nonzero pb
                  =>
                  nonzero <$> to_expr ` `( div_ne_zero_of_pos_of_ne_zero $ ( pa ) $ ( pb ) )
                |
                  nonzero pa , positive pb
                  =>
                  nonzero <$> to_expr ` `( div_ne_zero_of_ne_zero_of_pos $ ( pa ) $ ( pb ) )
                |
                  nonzero pa , nonzero pb
                  =>
                  nonzero <$> to_expr ` `( div_ne_zero $ ( pa ) $ ( pb ) )
                | sa @ _ , sb @ _ => positivity_fail e a b sa sb
      | e => pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `a / b`"
#align tactic.positivity_div tactic.positivity_div

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Extension for the `positivity` tactic: an inverse of a positive number is positive, an inverse
      of a nonnegative number is nonnegative. -/
    @[ positivity ]
    unsafe
  def
    positivity_inv
    : expr → tactic strictness
    |
        q( $ ( a ) ⁻¹ )
        =>
        do
          let strictness_a ← core a
            match
              strictness_a
              with
              | positive pa => positive <$> mk_app ` ` inv_pos_of_pos [ pa ]
                | nonnegative pa => nonnegative <$> mk_app ` ` inv_nonneg_of_nonneg [ pa ]
                | nonzero pa => nonzero <$> to_expr ` `( inv_ne_zero $ ( pa ) )
      | e => pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `a⁻¹`"
#align tactic.positivity_inv tactic.positivity_inv

private theorem pow_zero_pos [OrderedSemiring R] [Nontrivial R] (a : R) : 0 < a ^ 0 :=
  zero_lt_one.trans_le (pow_zero a).ge
#align tactic.pow_zero_pos tactic.pow_zero_pos

private theorem zpow_zero_pos [LinearOrderedSemifield R] (a : R) : 0 < a ^ (0 : ℤ) :=
  zero_lt_one.trans_le (zpow_zero a).ge
#align tactic.zpow_zero_pos tactic.zpow_zero_pos

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Extension for the `positivity` tactic: raising a number `a` to a natural/integer power `n` is
      positive if `n = 0` (since `a ^ 0 = 1`) or if `0 < a`, and is nonnegative if `n` is even (squares
      are nonnegative) or if `0 ≤ a`. -/
    @[ positivity ]
    unsafe
  def
    positivity_pow
    : expr → tactic strictness
    |
        e @ q( $ ( a ) ^ $ ( n ) )
        =>
        do
          let typ ← infer_type n
            (
                do
                  unify typ q( ℕ )
                    if
                      n = q( 0 )
                      then
                      positive <$> mk_app ` ` pow_zero_pos [ a ]
                      else
                      do
                        (
                            match
                              n
                              with
                              |
                                  q( bit0 $ ( n ) )
                                  =>
                                  nonnegative <$> mk_app ` ` pow_bit0_nonneg [ a , n ]
                                |
                                  _
                                  =>
                                  do
                                    let e' ← pp e
                                      fail
                                        (
                                          e'
                                            ++
                                            "is not an even power so positivity can't prove it's nonnegative"
                                          )
                            )
                          ≤|≥
                          do
                            let strictness_a ← core a
                              match
                                strictness_a
                                with
                                | positive p => positive <$> mk_app ` ` pow_pos [ p , n ]
                                  | nonnegative p => nonnegative <$> mk_app `pow_nonneg [ p , n ]
                                  |
                                    nonzero p
                                    =>
                                    nonzero <$> to_expr ` `( pow_ne_zero $ ( n ) $ ( p ) )
                )
              <|>
              do
                unify typ q( ℤ )
                  if
                    n = q( ( 0 : ℤ ) )
                    then
                    positive <$> mk_app ` ` zpow_zero_pos [ a ]
                    else
                    do
                      (
                          match
                            n
                            with
                            |
                                q( bit0 $ ( n ) )
                                =>
                                nonnegative <$> mk_app ` ` zpow_bit0_nonneg [ a , n ]
                              |
                                _
                                =>
                                do
                                  let e' ← pp e
                                    fail
                                      (
                                        e'
                                          ++
                                          "is not an even power so positivity can't prove it's nonnegative"
                                        )
                          )
                        ≤|≥
                        do
                          let strictness_a ← core a
                            match
                              strictness_a
                              with
                              | positive p => positive <$> mk_app ` ` zpow_pos_of_pos [ p , n ]
                                | nonnegative p => nonnegative <$> mk_app ` ` zpow_nonneg [ p , n ]
                                |
                                  nonzero p
                                  =>
                                  nonzero <$> to_expr ` `( zpow_ne_zero $ ( n ) $ ( p ) )
      | e => pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `a ^ n`"
#align tactic.positivity_pow tactic.positivity_pow

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Extension for the `positivity` tactic: raising a positive number in a canonically ordered
      semiring gives a positive number. -/
    @[ positivity ]
    unsafe
  def
    positivity_canon_pow
    : expr → tactic strictness
    |
        q( $ ( r ) ^ $ ( n ) )
        =>
        do
          let typ_n ← infer_type n
            unify typ_n q( ℕ )
            let positive p ← core r
            positive <$> mk_app ` ` CanonicallyOrderedCommSemiring.pow_pos [ p , n ]
      |
        e
        =>
        pp e
          >>=
          fail
            ∘
            format.bracket
              "The expression `"
                "` is not of the form `a ^ n` for `a` in a `canonically_ordered_comm_semiring` and `n : ℕ`"
#align tactic.positivity_canon_pow tactic.positivity_canon_pow

/- ./././Mathport/Syntax/Translate/Tactic/Basic.lean:87:10: unsupported modifiers in user command -/
alias abs_pos ↔ _ abs_pos_of_ne_zero
#align tactic.abs_pos_of_ne_zero Tactic.abs_pos_of_ne_zero

/-- Extension for the `positivity` tactic: an absolute value is nonnegative, and is strictly
positive if its input is nonzero. -/
@[positivity]
unsafe def positivity_abs : expr → tactic strictness
  | q(|$(a)|) => do
    (-- if can prove `0 < a` or `a ≠ 0`, report positivity
        do
          let strict_a ← core a
          match strict_a with
            | positive p => positive <$> mk_app `` abs_pos_of_pos [p]
            | nonzero p => positive <$> mk_app `` abs_pos_of_ne_zero [p]
            | _ => failed) <|>
        nonnegative <$> mk_app `` abs_nonneg [a]
  |-- else report nonnegativity
    e =>
    pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `|a|`"
#align tactic.positivity_abs tactic.positivity_abs

private theorem int_nat_abs_pos {n : ℤ} (hn : 0 < n) : 0 < n.natAbs :=
  Int.natAbs_pos_of_ne_zero hn.ne'
#align tactic.int_nat_abs_pos tactic.int_nat_abs_pos

/-- Extension for the `positivity` tactic: `int.nat_abs` is positive when its input is.

Since the output type of `int.nat_abs` is `ℕ`, the nonnegative case is handled by the default
`positivity` tactic.
-/
@[positivity]
unsafe def positivity_nat_abs : expr → tactic strictness
  | q(Int.natAbs $(a)) => do
    let strict_a ← core a
    match strict_a with
      | positive p => positive <$> mk_app `` int_nat_abs_pos [p]
      | nonzero p => positive <$> mk_app `` Int.natAbs_pos_of_ne_zero [p]
      | _ => failed
  | _ => failed
#align tactic.positivity_nat_abs tactic.positivity_nat_abs

private theorem nat_cast_pos [OrderedSemiring α] [Nontrivial α] {n : ℕ} : 0 < n → 0 < (n : α) :=
  Nat.cast_pos.2
#align tactic.nat_cast_pos tactic.nat_cast_pos

private theorem int_coe_nat_nonneg (n : ℕ) : 0 ≤ (n : ℤ) :=
  n.cast_nonneg
#align tactic.int_coe_nat_nonneg tactic.int_coe_nat_nonneg

private theorem int_coe_nat_pos {n : ℕ} : 0 < n → 0 < (n : ℤ) :=
  Nat.cast_pos.2
#align tactic.int_coe_nat_pos tactic.int_coe_nat_pos

private theorem int_cast_ne_zero [AddGroupWithOne α] [CharZero α] {n : ℤ} : n ≠ 0 → (n : α) ≠ 0 :=
  Int.cast_ne_zero.2
#align tactic.int_cast_ne_zero tactic.int_cast_ne_zero

private theorem int_cast_nonneg [OrderedRing α] {n : ℤ} (hn : 0 ≤ n) : 0 ≤ (n : α) :=
  by
  rw [← Int.cast_zero]
  exact Int.cast_mono hn
#align tactic.int_cast_nonneg tactic.int_cast_nonneg

private theorem int_cast_pos [OrderedRing α] [Nontrivial α] {n : ℤ} : 0 < n → 0 < (n : α) :=
  Int.cast_pos.2
#align tactic.int_cast_pos tactic.int_cast_pos

private theorem rat_cast_ne_zero [DivisionRing α] [CharZero α] {q : ℚ} : q ≠ 0 → (q : α) ≠ 0 :=
  Rat.cast_ne_zero.2
#align tactic.rat_cast_ne_zero tactic.rat_cast_ne_zero

private theorem rat_cast_nonneg [LinearOrderedField α] {q : ℚ} : 0 ≤ q → 0 ≤ (q : α) :=
  Rat.cast_nonneg.2
#align tactic.rat_cast_nonneg tactic.rat_cast_nonneg

private theorem rat_cast_pos [LinearOrderedField α] {q : ℚ} : 0 < q → 0 < (q : α) :=
  Rat.cast_pos.2
#align tactic.rat_cast_pos tactic.rat_cast_pos

/-- Extension for the `positivity` tactic: casts from `ℕ`, `ℤ`, `ℚ`. -/
@[positivity]
unsafe def positivity_coe : expr → tactic strictness
  | q(@coe _ $(typ) $(inst) $(a)) => do
    -- TODO: Using `match` here might turn out too strict since we really want the instance to *unify*
      -- with one of the instances below rather than being equal on the nose.
      -- If this turns out to indeed be a problem, we should figure out the right way to pattern match
      -- up to defeq rather than equality of expressions.
      -- See also "Reflexive tactics for algebra, revisited" by Kazuhiko Sakaguchi at ITP 2022.
      match inst with
      | q(@coeToLift _ _ $(inst)) => do
        let strictness_a ← core a
        match inst, strictness_a with
          |-- `mk_mapp` is necessary in some places. Why?
            q(Nat.castCoe),
            positive p => positive <$> mk_mapp `` nat_cast_pos [typ, none, none, none, p]
          | q(Nat.castCoe), _ => nonnegative <$> mk_mapp `` Nat.cast_nonneg [typ, none, a]
          | q(Int.castCoe), positive p =>
            positive <$> mk_mapp `` int_cast_pos [typ, none, none, none, p]
          | q(Int.castCoe), nonnegative p =>
            nonnegative <$> mk_mapp `` int_cast_nonneg [typ, none, none, p]
          | q(Int.castCoe), nonzero p =>
            nonzero <$> mk_mapp `` int_cast_ne_zero [typ, none, none, none, p]
          | q(Rat.castCoe), positive p => positive <$> mk_mapp `` rat_cast_pos [typ, none, none, p]
          | q(Rat.castCoe), nonnegative p =>
            nonnegative <$> mk_mapp `` rat_cast_nonneg [typ, none, none, p]
          | q(Rat.castCoe), nonzero p =>
            nonzero <$> mk_mapp `` rat_cast_ne_zero [typ, none, none, none, p]
          | q(@coeBase _ _ Int.hasCoe), positive p => positive <$> mk_app `` int_coe_nat_pos [p]
          | q(@coeBase _ _ Int.hasCoe), _ => nonnegative <$> mk_app `` int_coe_nat_nonneg [a]
          | _, _ => failed
      | _ => failed
  | _ => failed
#align tactic.positivity_coe tactic.positivity_coe

/-- Extension for the `positivity` tactic: `nat.succ` is always positive. -/
@[positivity]
unsafe def positivity_succ : expr → tactic strictness
  | q(Nat.succ $(a)) => positive <$> mk_app `nat.succ_pos [a]
  | e => pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `nat.succ n`"
#align tactic.positivity_succ tactic.positivity_succ

/-- Extension for the `positivity` tactic: `nat.factorial` is always positive. -/
@[positivity]
unsafe def positivity_factorial : expr → tactic strictness
  | q(Nat.factorial $(a)) => positive <$> mk_app `` Nat.factorial_pos [a]
  | e => pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `n!`"
#align tactic.positivity_factorial tactic.positivity_factorial

/-- Extension for the `positivity` tactic: `nat.asc_factorial` is always positive. -/
@[positivity]
unsafe def positivity_asc_factorial : expr → tactic strictness
  | q(Nat.ascFactorial $(a) $(b)) => positive <$> mk_app `` Nat.ascFactorial_pos [a, b]
  | e =>
    pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `nat.asc_factorial n k`"
#align tactic.positivity_asc_factorial tactic.positivity_asc_factorial

/-- Extension for the `positivity` tactic: nonnegative maps take nonnegative values. -/
@[positivity]
unsafe def positivity_map : expr → tactic strictness
  | expr.app q(⇑$(f)) q($(a)) => nonnegative <$> mk_app `` map_nonneg [f, a]
  | _ => failed
#align tactic.positivity_map tactic.positivity_map

end Tactic


/-
Copyright (c) 2022 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou

! This file was ported from Lean 3 source module algebraic_topology.dold_kan.projections
! leanprover-community/mathlib commit ed98c07faf6d9de3e52771d5b00394c4294ccb4d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicTopology.DoldKan.Faces
import Mathbin.CategoryTheory.Idempotents.Basic

/-!

# Construction of projections for the Dold-Kan correspondence

TODO (@joelriou) continue adding the various files referenced below

In this file, we construct endomorphisms `P q : K[X] ⟶ K[X]` for all
`q : ℕ`. We study how they behave with respect to face maps with the lemmas
`higher_faces_vanish.of_P`, `higher_faces_vanish.comp_P_eq_self` and
`comp_P_eq_self_iff`.

Then, we show that they are projections (see `P_f_idem`
and `P_idem`). They are natural transformations (see `nat_trans_P`
and `P_f_naturality`) and are compatible with the application
of additive functors (see `map_P`).

By passing to the limit, these endomorphisms `P q` shall be used in `p_infty.lean`
in order to define `P_infty : K[X] ⟶ K[X]`, see `equivalence.lean` for the general
strategy of proof of the Dold-Kan equivalence.

-/

open
  CategoryTheory CategoryTheory.Category CategoryTheory.Limits CategoryTheory.Preadditive CategoryTheory.SimplicialObject Opposite CategoryTheory.Idempotents

open Simplicial DoldKan

noncomputable section

namespace AlgebraicTopology

namespace DoldKan

variable {C : Type _} [Category C] [Preadditive C] {X : SimplicialObject C}

/-- This is the inductive definition of the projections `P q : K[X] ⟶ K[X]`,
with `P 0 := 𝟙 _` and `P (q+1) := P q ≫ (𝟙 _ + Hσ q)`. -/
noncomputable def p : ℕ → (K[X] ⟶ K[X])
  | 0 => 𝟙 _
  | q + 1 => P q ≫ (𝟙 _ + hσ q)
#align algebraic_topology.dold_kan.P AlgebraicTopology.DoldKan.p

/-- All the `P q` coincide with `𝟙 _` in degree 0. -/
@[simp]
theorem p_f_0_eq (q : ℕ) : ((p q).f 0 : X _[0] ⟶ X _[0]) = 𝟙 _ :=
  by
  induction' q with q hq
  · rfl
  · unfold P
    simp only [HomologicalComplex.add_f_apply, HomologicalComplex.comp_f, HomologicalComplex.id_f,
      id_comp, hq, Hσ_eq_zero, add_zero]
#align algebraic_topology.dold_kan.P_f_0_eq AlgebraicTopology.DoldKan.p_f_0_eq

/-- `Q q` is the complement projection associated to `P q` -/
def q (q : ℕ) : K[X] ⟶ K[X] :=
  𝟙 _ - p q
#align algebraic_topology.dold_kan.Q AlgebraicTopology.DoldKan.q

theorem p_add_q (q : ℕ) : p q + q q = 𝟙 K[X] :=
  by
  rw [Q]
  abel
#align algebraic_topology.dold_kan.P_add_Q AlgebraicTopology.DoldKan.p_add_q

theorem p_add_q_f (q n : ℕ) : (p q).f n + (q q).f n = 𝟙 (X _[n]) :=
  HomologicalComplex.congr_hom (p_add_q q) n
#align algebraic_topology.dold_kan.P_add_Q_f AlgebraicTopology.DoldKan.p_add_q_f

@[simp]
theorem q_eq_zero : (q 0 : K[X] ⟶ _) = 0 :=
  sub_self _
#align algebraic_topology.dold_kan.Q_eq_zero AlgebraicTopology.DoldKan.q_eq_zero

theorem q_eq (q : ℕ) : (q (q + 1) : K[X] ⟶ _) = q q - p q ≫ hσ q :=
  by
  unfold Q P
  simp only [comp_add, comp_id]
  abel
#align algebraic_topology.dold_kan.Q_eq AlgebraicTopology.DoldKan.q_eq

/-- All the `Q q` coincide with `0` in degree 0. -/
@[simp]
theorem q_f_0_eq (q : ℕ) : ((q q).f 0 : X _[0] ⟶ X _[0]) = 0 := by
  simp only [HomologicalComplex.sub_f_apply, HomologicalComplex.id_f, Q, P_f_0_eq, sub_self]
#align algebraic_topology.dold_kan.Q_f_0_eq AlgebraicTopology.DoldKan.q_f_0_eq

namespace HigherFacesVanish

/-- This lemma expresses the vanishing of
`(P q).f (n+1) ≫ X.δ k : X _[n+1] ⟶ X _[n]` when `k≠0` and `k≥n-q+2` -/
theorem of_p : ∀ q n : ℕ, HigherFacesVanish q ((p q).f (n + 1) : X _[n + 1] ⟶ X _[n + 1])
  | 0 => fun n j hj₁ => by
    exfalso
    have hj₂ := Fin.is_lt j
    linarith
  | q + 1 => fun n => by
    unfold P
    exact (of_P q n).induction
#align algebraic_topology.dold_kan.higher_faces_vanish.of_P AlgebraicTopology.DoldKan.HigherFacesVanish.of_p

@[reassoc.1]
theorem comp_p_eq_self {Y : C} {n q : ℕ} {φ : Y ⟶ X _[n + 1]} (v : HigherFacesVanish q φ) :
    φ ≫ (p q).f (n + 1) = φ := by
  induction' q with q hq
  · unfold P
    apply comp_id
  · unfold P
    simp only [comp_add, HomologicalComplex.comp_f, HomologicalComplex.add_f_apply, comp_id, ←
      assoc, hq v.of_succ, add_right_eq_self]
    by_cases hqn : n < q
    · exact v.of_succ.comp_Hσ_eq_zero hqn
    · cases' Nat.le.dest (not_lt.mp hqn) with a ha
      have hnaq : n = a + q := by linarith
      simp only [v.of_succ.comp_Hσ_eq hnaq, neg_eq_zero, ← assoc]
      have eq :=
        v ⟨a, by linarith⟩ (by simp only [hnaq, Fin.val_mk, Nat.succ_eq_add_one, add_assoc])
      simp only [Fin.succ_mk] at eq
      simp only [Eq, zero_comp]
#align algebraic_topology.dold_kan.higher_faces_vanish.comp_P_eq_self AlgebraicTopology.DoldKan.HigherFacesVanish.comp_p_eq_self

end HigherFacesVanish

theorem comp_p_eq_self_iff {Y : C} {n q : ℕ} {φ : Y ⟶ X _[n + 1]} :
    φ ≫ (p q).f (n + 1) = φ ↔ HigherFacesVanish q φ :=
  by
  constructor
  · intro hφ
    rw [← hφ]
    apply higher_faces_vanish.of_comp
    apply higher_faces_vanish.of_P
  · exact higher_faces_vanish.comp_P_eq_self
#align algebraic_topology.dold_kan.comp_P_eq_self_iff AlgebraicTopology.DoldKan.comp_p_eq_self_iff

@[simp, reassoc.1]
theorem p_f_idem (q n : ℕ) : ((p q).f n : X _[n] ⟶ _) ≫ (p q).f n = (p q).f n :=
  by
  cases n
  · rw [P_f_0_eq q, comp_id]
  · exact (higher_faces_vanish.of_P q n).comp_p_eq_self
#align algebraic_topology.dold_kan.P_f_idem AlgebraicTopology.DoldKan.p_f_idem

@[simp, reassoc.1]
theorem q_f_idem (q n : ℕ) : ((q q).f n : X _[n] ⟶ _) ≫ (q q).f n = (q q).f n :=
  idem_of_id_sub_idem _ (p_f_idem q n)
#align algebraic_topology.dold_kan.Q_f_idem AlgebraicTopology.DoldKan.q_f_idem

@[simp, reassoc.1]
theorem p_idem (q : ℕ) : (p q : K[X] ⟶ K[X]) ≫ p q = p q :=
  by
  ext n
  exact P_f_idem q n
#align algebraic_topology.dold_kan.P_idem AlgebraicTopology.DoldKan.p_idem

@[simp, reassoc.1]
theorem q_idem (q : ℕ) : (q q : K[X] ⟶ K[X]) ≫ q q = q q :=
  by
  ext n
  exact Q_f_idem q n
#align algebraic_topology.dold_kan.Q_idem AlgebraicTopology.DoldKan.q_idem

/-- For each `q`, `P q` is a natural transformation. -/
@[simps]
def natTransP (q : ℕ) : alternatingFaceMapComplex C ⟶ alternatingFaceMapComplex C
    where
  app X := p q
  naturality' X Y f := by
    induction' q with q hq
    · unfold P
      dsimp only [alternating_face_map_complex]
      rw [id_comp, comp_id]
    · unfold P
      simp only [add_comp, comp_add, assoc, comp_id, hq]
      congr 1
      rw [← assoc, hq, assoc]
      congr 1
      exact (nat_trans_Hσ q).naturality' f
#align algebraic_topology.dold_kan.nat_trans_P AlgebraicTopology.DoldKan.natTransP

@[simp, reassoc.1]
theorem p_f_naturality (q n : ℕ) {X Y : SimplicialObject C} (f : X ⟶ Y) :
    f.app (op [n]) ≫ (p q).f n = (p q).f n ≫ f.app (op [n]) :=
  HomologicalComplex.congr_hom ((natTransP q).naturality f) n
#align algebraic_topology.dold_kan.P_f_naturality AlgebraicTopology.DoldKan.p_f_naturality

@[simp, reassoc.1]
theorem q_f_naturality (q n : ℕ) {X Y : SimplicialObject C} (f : X ⟶ Y) :
    f.app (op [n]) ≫ (q q).f n = (q q).f n ≫ f.app (op [n]) :=
  by
  simp only [Q, HomologicalComplex.sub_f_apply, HomologicalComplex.id_f, comp_sub, P_f_naturality,
    sub_comp, sub_left_inj]
  dsimp
  simp only [comp_id, id_comp]
#align algebraic_topology.dold_kan.Q_f_naturality AlgebraicTopology.DoldKan.q_f_naturality

/-- For each `q`, `Q q` is a natural transformation. -/
@[simps]
def natTransQ (q : ℕ) : alternatingFaceMapComplex C ⟶ alternatingFaceMapComplex C where app X := q q
#align algebraic_topology.dold_kan.nat_trans_Q AlgebraicTopology.DoldKan.natTransQ

theorem map_p {D : Type _} [Category D] [Preadditive D] (G : C ⥤ D) [G.Additive]
    (X : SimplicialObject C) (q n : ℕ) :
    G.map ((p q : K[X] ⟶ _).f n) = (p q : K[((whiskering C D).obj G).obj X] ⟶ _).f n :=
  by
  induction' q with q hq
  · unfold P
    apply G.map_id
  · unfold P
    simp only [comp_add, HomologicalComplex.comp_f, HomologicalComplex.add_f_apply, comp_id,
      functor.map_add, functor.map_comp, hq, map_Hσ]
#align algebraic_topology.dold_kan.map_P AlgebraicTopology.DoldKan.map_p

theorem map_q {D : Type _} [Category D] [Preadditive D] (G : C ⥤ D) [G.Additive]
    (X : SimplicialObject C) (q n : ℕ) :
    G.map ((q q : K[X] ⟶ _).f n) = (q q : K[((whiskering C D).obj G).obj X] ⟶ _).f n :=
  by
  rw [← add_right_inj (G.map ((P q : K[X] ⟶ _).f n)), ← G.map_add, map_P G X q n, P_add_Q_f,
    P_add_Q_f]
  apply G.map_id
#align algebraic_topology.dold_kan.map_Q AlgebraicTopology.DoldKan.map_q

end DoldKan

end AlgebraicTopology


import tutorial_world.level13_leftright --hide
open IncidencePlane --hide
/- Tactic : apply

## Summary

If `h : P → Q` is a hypothesis, and the goal is `⊢ Q` then
`apply h` changes the goal to `⊢ P`.

## Details

If you have a function `h : P → Q` and your goal is `⊢ Q`
then `apply h` changes the goal to `⊢ P`. The logic is
simple: if you are trying to create a term of type `Q`,
but `h` is a function which turns terms of type `P` into
terms of type `Q`, then it will suffice to construct a
term of type `P`. A mathematician might say: "we need
to construct an element of $Q$, but we have a function $h:P\to Q$
so it suffices to construct an element of $P$". Or alternatively
"we need to prove $Q$, but we have a proof $h$ that $P\implies Q$
so it suffices to prove $P$".

-/

/-
In this level we introduce the new tactic `apply`. Suppose that you have a theorem `h`
that states exactly that your goal is true, provided that some hypotheses are satisfied. Then
`apply h` will change your goal into proving your new hypotheses.
-/

variables {Ω : Type} [IncidencePlane Ω] -- hide
variables {P Q : Ω} -- hide

/- Lemma :
The line through two points is a symmetrical concept
-/
lemma line_through_symmetrical (h : P ≠ Q) : line_through Q P = line_through P Q :=
begin
  apply incidence,
  {
    exact h,
  },
  {
    exact line_through_right Q P,
  },
  {
    exact line_through_left Q P,
  }

end


import schur_theorem.schur
import data.complex.basic
import Tools.tools
import Tools.eigen_value
import linear_algebra.caracteristic_polynomial
import basic_definitions.matrix_representation
import basic_definitions.equiv
import permutation_representation.regular_representation
import Reynold_operator.reynold_scalar_product
set_option pp.generalized_field_notation false
open_locale big_operators
universes u v w w'
open car_pol
variables {G : Type u} [group G]
          {X : Type v} [fintype X][decidable_eq X]
          {ρ : group_representation G ℂ (X → ℂ)}
open  Schur₂ morphism.from_irreductible equiv_morphism shur₁_comm_ring stability pequiv
open  Reynold
/--

-/
theorem eigen_values_exist (hyp : 0 < fintype.card X ) : ∀ f : (X → ℂ ) →ₗ[ℂ] (X → ℂ),  ∃ t : ℂ, ∃ φ  : (X → ℂ ),
 (φ ≠ 0) ∧  (f φ + t • φ =0) := begin
    intro f,
    rcases eigen_values_exist_mat hyp (linear_map.to_matrix f) with ⟨w, hyp_w⟩  ,
    let t := exist_ker_not_trivial (f+ w • 1),
    use w,  apply t,
    have : linear_map.to_matrix f + w • 1 = linear_map.to_matrix (f + w • 1),
        rw to_matrix_add, rw to_matrix_smul, rw to_matrix_one,
    rw ← this, assumption,
 end

theorem Schur_on (hyp : 0 < fintype.card X ) [Irreductible ρ] (f : ρ ⟶ᵣ ρ) :
        ∃ t : ℂ, f + t • 1  = 0  :=
begin
    rcases eigen_values_exist hyp f.ℓ with ⟨t,⟨ φ, hyp_t⟩ ⟩,
    use t,
    apply morphism.ext, apply linear_map.ext,
    exact Schur₂ f t φ hyp_t,
 end
/--
    Universe Y  = Univrse X ? here i put the dsame for matrix !!!
-/
variables {Y : Type v} [fintype Y][decidable_eq Y] {ρ' : group_representation G ℂ (Y → ℂ)}

variables [fintype G][decidable_eq G]

open matrix linear_map character
open_locale matrix

/--
Le theorem vit sans hypothèse
-/
theorem 𝒪ℛ𝒯ℋ𝒪  (F : not_isomorphic ρ ρ')[Irreductible ρ ][Irreductible ρ'] :
scalar_product G ℂ   (χ ρ ) (χ ρ' ) = 0 :=
begin
    rw interpretation_produit_scalaire ρ ρ',
    apply finset.sum_eq_zero,
    intros,
    rw Reynold_is_zero F, exact rfl,
end

open Ring

lemma proof_strategy₃  (a b: ℂ ) (hyp : b   ≠ 0) (M N : matrix X X ℂ ): a • M = b • N → N = (b ⁻¹ * a) • M :=
begin
    intros, rw mul_smul_mat, rw a_1,
     erw ← mul_smul_mat, rw inv_mul_cancel, rw one_smul, exact hyp,
end

/--
    Faire mieux !!!  hyp et hyp'
-/
lemma Schur_grallr [Irreductible ρ] (f : ρ ⟶ᵣ ρ ) (hyp' : 0 < fintype.card X ) (hyp : fintype.card X ≠ 0)  :
(to_matrix f.ℓ) = ((fintype.card X : ℂ)⁻¹ * (matrix.trace X  ℂ  ℂ (linear_map.to_matrix f.ℓ))) •  1
:= begin
    apply proof_strategy₃,
    refine function.injective.ne (nat.cast_injective) hyp,
    rcases Schur_on hyp' f with ⟨ζ, hyp⟩,
    have  : f.ℓ + ζ • (1 : ρ ⟶ᵣ ρ).ℓ = 0,
        erw ← morphism_module.coe_smul,
        rw ← morphism_module.add_coe, rw hyp, exact rfl,
    rw homo_eq_diag f.ℓ ζ  this, rw map_smul, rw trace_one,
    erw ← mul_smul_mat,
    rw mul_comm,
    exact rfl,
end

lemma proof_strategy₂ (a : ℂ ) {  c d : ℂ } :  c = d  →    a * c = a * d := congr_arg (λ x, a * x)

lemma Reynold_E  (ρ : group_representation G ℂ (X → ℂ)) [Irreductible ρ ](hyp' : 0 < fintype.card X ) (hyp : fintype.card X ≠ 0)(x : X × X)  :
to_matrix ((Re ρ ρ) (to_lin (ℰ x.snd x.fst))).ℓ x.snd x.fst =   ↑(fintype.card G) * (↑(fintype.card X))⁻¹ * (trace X ℂ ℂ) (ℰ x.snd x.fst) :=
begin
    rw Schur_grallr ((Re ρ ρ) (to_lin (ℰ x.snd x.fst)))hyp'  hyp,
    -- clean up
    rw [ smul_val,  one_val, mul_assoc,  mul_comm ↑(fintype.card G),  mul_assoc],
    apply proof_strategy₂ (↑(fintype.card X))⁻¹,
    rw to_matrix_Reynold_E,
    rw trace_E, split_ifs,
        -- (trace ∑ = ∑ trace) and (trace conjugate = trace) and (trace ℰ x x = 1)
        {rw h,rw trace_Reynold_E,},
        -- trivial
        {repeat {rw mul_zero}},
end

lemma 𝒪𝓇𝓉𝒽ℴ (ρ : group_representation G ℂ (X → ℂ ))  [Irreductible ρ ] (hyp' : 0 < fintype.card X )(hyp : fintype.card X ≠ 0) :
scalar_product G ℂ  (χ ρ ) (χ ρ ) = (fintype.card G : ℂ ) :=
begin
    rw interpretation_produit_scalaire,
    conv_lhs{
        apply_congr, skip,
        rw Reynold_E ρ hyp' hyp,
        rw trace_E,
    },
    rw ← finset.mul_sum,
    -- ∑ x  : X × X, ite (x.fst  = x.snd) 1 0 = card X ... the diagonal equivalence
    erw sum_diagonal_one_eq_cardinal X ℂ,
    rw mul_assoc,rw inv_mul_cancel,rw mul_one,
    exact function.injective.ne (nat.cast_injective) hyp,
end

theorem scalar_product_equiv (ρ : group_representation G ℂ (X → ℂ ))  [Irreductible ρ ] (ρ' : group_representation G ℂ (Y → ℂ ))
(iso : is_isomorphic ρ ρ' ) [Irreductible ρ ] (hyp' : 0 < fintype.card X )
(hyp : fintype.card X ≠ 0) : scalar_product G ℂ  (χ ρ ) (χ ρ' ) = (fintype.card G : ℂ ) := begin
    rw ←  equivalence.carac_eq' ρ ρ' iso,
    erw 𝒪𝓇𝓉𝒽ℴ ρ,exact hyp', exact hyp,
end
noncomputable instance : decidable (is_isomorphic ρ ρ' ) := begin
    exact classical.dec (is_isomorphic ρ ρ'),
end
theorem scalar_product_ite (ρ : group_representation G ℂ (X → ℂ ))  [Irreductible ρ ] (ρ' : group_representation G ℂ (Y → ℂ ))
 [Irreductible ρ' ](hyp' : 0 < fintype.card X )
(hyp : fintype.card X ≠ 0) :  scalar_product G ℂ  (χ ρ ) (χ ρ' ) = if (is_isomorphic ρ ρ') then (fintype.card G : ℂ ) else 0
:= begin
    split_ifs,  apply scalar_product_equiv (by assumption), exact h, exact hyp', exact hyp,
    let  := non_is_isomorphic_eq_not_isomorphic ρ ρ' h,
    exact 𝒪ℛ𝒯ℋ𝒪 this ,
end

example (ρ : group_representation G ℂ (X → ℂ )) [Irreductible ρ ]
                (hyp : fintype.card X ≠ 0) (hyp' : 0 < fintype.card X ) :

    (↑(fintype.card G))⁻¹ * ∑ (t : G), χ ρ t * χ ρ t⁻¹ = 1 :=
begin
    let g := 𝒪𝓇𝓉𝒽ℴ ρ hyp' hyp,
    rw scalar_product_ext at g,
    rw g, apply inv_mul_cancel,rw coe_to_lift, simp,
     intro,
    let r := finset.card_eq_zero.mp a, have : ( 1 : G) ∈ finset.univ, --- grrrrrrrrrr
        refine finset.mem_univ 1,
    finish,
end
example (F : not_isomorphic ρ ρ')[Irreductible ρ ][Irreductible ρ'] :

         (↑(fintype.card G))⁻¹ *   ∑ (t : G), χ ρ t * χ ρ' t⁻¹ = 0  :=
begin
    let g := 𝒪ℛ𝒯ℋ𝒪 F,
    rw scalar_product_ext at g,
    rw g, erw mul_zero,
end

#check Regular.Regular_representation
/--
    OKay for other ring than `ℂ` !
-/
theorem scalar_product_with_regular (ρ : group_representation G ℂ (X → ℂ )) :
scalar_product G ℂ (χ ρ) (χ (Regular.Regular_representation G ℂ )) =  (χ ρ 1) * (fintype.card G) :=
begin
    rw scalar_product_ext,
    conv_lhs{
        apply_congr,skip,
        rw Regular.character_of_regular_representation, rw mul_ite, rw mul_zero,
    },
    rw finset.sum_ite,
     rw finset.sum_const_zero, rw add_zero,simp,rw finset.sum_filter,
     rw finset.sum_ite_eq',split_ifs,
     rw χ_one,
     let t := (finset.mem_univ (1 : G)),trivial,
end


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import analysis.analytic.basic

/-!
# Linear functions are analytic

In this file we prove that a `continuous_linear_map` defines an analytic function with
the formal power series `f x = f a + f (x - a)`.
-/

variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
{G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G]

open_locale topology classical big_operators nnreal ennreal
open set filter asymptotics

noncomputable theory

namespace continuous_linear_map

/-- Formal power series of a continuous linear map `f : E →L[𝕜] F` at `x : E`:
`f y = f x + f (y - x)`. -/
@[simp] def fpower_series (f : E →L[𝕜] F) (x : E) : formal_multilinear_series 𝕜 E F
| 0 := continuous_multilinear_map.curry0 𝕜 _ (f x)
| 1 := (continuous_multilinear_curry_fin1 𝕜 E F).symm f
| _ := 0

@[simp] lemma fpower_series_apply_add_two (f : E →L[𝕜] F) (x : E) (n : ℕ) :
  f.fpower_series x (n + 2) = 0 := rfl

@[simp] lemma fpower_series_radius (f : E →L[𝕜] F) (x : E) : (f.fpower_series x).radius = ∞ :=
(f.fpower_series x).radius_eq_top_of_forall_image_add_eq_zero 2 $ λ n, rfl

protected theorem has_fpower_series_on_ball (f : E →L[𝕜] F) (x : E) :
  has_fpower_series_on_ball f (f.fpower_series x) x ∞ :=
{ r_le := by simp,
  r_pos := ennreal.coe_lt_top,
  has_sum := λ y _, (has_sum_nat_add_iff' 2).1 $
    by simp [finset.sum_range_succ, ← sub_sub, has_sum_zero] }

protected theorem has_fpower_series_at (f : E →L[𝕜] F) (x : E) :
  has_fpower_series_at f (f.fpower_series x) x :=
⟨∞, f.has_fpower_series_on_ball x⟩

protected theorem analytic_at (f : E →L[𝕜] F) (x : E) : analytic_at 𝕜 f x :=
(f.has_fpower_series_at x).analytic_at

/-- Reinterpret a bilinear map `f : E →L[𝕜] F →L[𝕜] G` as a multilinear map
`(E × F) [×2]→L[𝕜] G`. This multilinear map is the second term in the formal
multilinear series expansion of `uncurry f`. It is given by
`f.uncurry_bilinear ![(x, y), (x', y')] = f x y'`. -/
def uncurry_bilinear (f : E →L[𝕜] F →L[𝕜] G) : (E × F) [×2]→L[𝕜] G :=
@continuous_linear_map.uncurry_left 𝕜 1 (λ _, E × F) G _ _ _ _ _ $
  (↑(continuous_multilinear_curry_fin1 𝕜 (E × F) G).symm : (E × F →L[𝕜] G) →L[𝕜] _).comp $
    f.bilinear_comp (fst _ _ _) (snd _ _ _)

@[simp] lemma uncurry_bilinear_apply (f : E →L[𝕜] F →L[𝕜] G) (m : fin 2 → E × F) :
  f.uncurry_bilinear m = f (m 0).1 (m 1).2 :=
rfl

/-- Formal multilinear series expansion of a bilinear function `f : E →L[𝕜] F →L[𝕜] G`. -/
@[simp] def fpower_series_bilinear (f : E →L[𝕜] F →L[𝕜] G) (x : E × F) :
  formal_multilinear_series 𝕜 (E × F) G
| 0 := continuous_multilinear_map.curry0 𝕜 _ (f x.1 x.2)
| 1 := (continuous_multilinear_curry_fin1 𝕜 (E × F) G).symm (f.deriv₂ x)
| 2 := f.uncurry_bilinear
| _ := 0

@[simp] lemma fpower_series_bilinear_radius (f : E →L[𝕜] F →L[𝕜] G) (x : E × F) :
  (f.fpower_series_bilinear x).radius = ∞ :=
(f.fpower_series_bilinear x).radius_eq_top_of_forall_image_add_eq_zero 3 $ λ n, rfl

protected

protected theorem has_fpower_series_at_bilinear (f : E →L[𝕜] F →L[𝕜] G) (x : E × F) :
  has_fpower_series_at (λ x : E × F, f x.1 x.2) (f.fpower_series_bilinear x) x :=
⟨∞, f.has_fpower_series_on_ball_bilinear x⟩

protected theorem analytic_at_bilinear (f : E →L[𝕜] F →L[𝕜] G) (x : E × F) :
  analytic_at 𝕜 (λ x : E × F, f x.1 x.2) x :=
(f.has_fpower_series_at_bilinear x).analytic_at

end continuous_linear_map