/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

! This file was ported from Lean 3 source module data.rbmap.default
! 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.Data.Rbmap.Basic
import Mathbin.Data.Rbtree.Main

universe u v

namespace Rbmap

variable {α : Type u} {β : Type v} {lt : α → α → Prop}

-- Auxiliary instances
private def rbmap_lt_is_swo {α : Type u} {β : Type v} {lt : α → α → Prop} [IsStrictWeakOrder α lt] :
    IsStrictWeakOrder (α × β) (RbmapLt lt)
    where
  irrefl _ := irrefl_of lt _
  trans _ _ _ h₁ h₂ := trans_of lt h₁ h₂
  incomp_trans _ _ _ h₁ h₂ := incomp_trans_of lt h₁ h₂
#align rbmap.rbmap_lt_is_swo rbmap.rbmap_lt_is_swo

private def rbmapLtDec {α : Type u} {β : Type v} {lt : α → α → Prop} [h : DecidableRel lt] :
    DecidableRel (@RbmapLt α β lt) := fun a b => h a.1 b.1
#align rbmap.rbmap_lt_dec Rbmap.rbmapLtDec

attribute [local instance] rbmap_lt_is_swo rbmap_lt_dec

-- Helper lemmas for reusing rbtree results.
private theorem to_rbtree_mem {k : α} {m : Rbmap α β lt} : k ∈ m → ∃ v : β, Rbtree.Mem (k, v) m :=
  by
  cases' m with n p <;> cases n <;> intro h
  · exact False.elim h
  all_goals exists n_val.2; exact h
#align rbmap.to_rbtree_mem rbmap.to_rbtree_mem

private theorem eqv_entries_of_eqv_keys {k₁ k₂ : α} (v₁ v₂ : β) :
    k₁ ≈[lt]k₂ → (k₁, v₁) ≈[RbmapLt lt](k₂, v₂) :=
  id
#align rbmap.eqv_entries_of_eqv_keys rbmap.eqv_entries_of_eqv_keys

private theorem eqv_keys_of_eqv_entries {k₁ k₂ : α} {v₁ v₂ : β} :
    (k₁, v₁) ≈[RbmapLt lt](k₂, v₂) → k₁ ≈[lt]k₂ :=
  id
#align rbmap.eqv_keys_of_eqv_entries rbmap.eqv_keys_of_eqv_entries

private theorem eqv_entries [IsIrrefl α lt] (k : α) (v₁ v₂ : β) : (k, v₁) ≈[RbmapLt lt](k, v₂) :=
  And.intro (irrefl_of lt k) (irrefl_of lt k)
#align rbmap.eqv_entries rbmap.eqv_entries

private theorem to_rbmap_mem [IsStrictWeakOrder α lt] {k : α} {v : β} {m : Rbmap α β lt} :
    Rbtree.Mem (k, v) m → k ∈ m :=
  by
  cases' m with n p <;> cases n <;> intro h
  · exact False.elim h
  · simp [Membership.Mem, Rbmap.Mem]
    exact
      @Rbtree.mem_of_mem_of_eqv _ _ _ ⟨Rbnode.red_node n_lchild n_val n_rchild, p⟩ _ _ h
        (eqv_entries _ _ _)
  · simp [Membership.Mem, Rbmap.Mem]
    exact
      @Rbtree.mem_of_mem_of_eqv _ _ _ ⟨Rbnode.black_node n_lchild n_val n_rchild, p⟩ _ _ h
        (eqv_entries _ _ _)
#align rbmap.to_rbmap_mem rbmap.to_rbmap_mem

private theorem to_rbtree_mem' [IsStrictWeakOrder α lt] {k : α} {m : Rbmap α β lt} (v : β) :
    k ∈ m → Rbtree.Mem (k, v) m := by
  intro h
  cases' to_rbtree_mem h with v' hm
  apply Rbtree.mem_of_mem_of_eqv hm
  apply eqv_entries
#align rbmap.to_rbtree_mem' rbmap.to_rbtree_mem'

theorem eq_some_of_toValue_eq_some {e : Option (α × β)} {v : β} :
    toValue e = some v → ∃ k, e = some (k, v) :=
  by
  cases' e with val <;> simp [to_value, false_imp_iff]
  · cases val
    simp
#align rbmap.eq_some_of_to_value_eq_some Rbmap.eq_some_of_toValue_eq_some

theorem eq_none_of_toValue_eq_none {e : Option (α × β)} : toValue e = none → e = none := by
  cases e <;> simp [to_value, false_imp_iff]
#align rbmap.eq_none_of_to_value_eq_none Rbmap.eq_none_of_toValue_eq_none

-- Lemmas
theorem not_mem_mkRbmap : ∀ k : α, k ∉ mkRbmap α β lt := by
  simp [Membership.Mem, mkRbmap, mkRbtree, Rbmap.Mem]
#align rbmap.not_mem_mk_rbmap Rbmap.not_mem_mkRbmap

theorem not_mem_of_empty {m : Rbmap α β lt} (k : α) : m.Empty = true → k ∉ m := by
  cases' m with n p <;> cases n <;>
    simp [Membership.Mem, mkRbmap, mkRbtree, Rbmap.Mem, Rbmap.empty, Rbtree.empty, false_imp_iff]
#align rbmap.not_mem_of_empty Rbmap.not_mem_of_empty

theorem mem_of_mem_of_eqv [IsStrictWeakOrder α lt] {m : Rbmap α β lt} {k₁ k₂ : α} :
    k₁ ∈ m → k₁ ≈[lt]k₂ → k₂ ∈ m := by
  intro h₁ h₂
  have h₁ := to_rbtree_mem h₁; cases' h₁ with v h₁
  exact to_rbmap_mem (Rbtree.mem_of_mem_of_eqv h₁ (eqv_entries_of_eqv_keys v v h₂))
#align rbmap.mem_of_mem_of_eqv Rbmap.mem_of_mem_of_eqv

section Decidable

variable [DecidableRel lt]

theorem not_mem_of_findEntry_none [IsStrictWeakOrder α lt] {k : α} {m : Rbmap α β lt} :
    m.findEntry k = none → k ∉ m := by
  cases' m with t p; cases t <;> simp [find_entry]
  · intros
    simp [Membership.Mem, Rbmap.Mem]
  all_goals intro h; exact Rbtree.not_mem_of_find_none h
#align rbmap.not_mem_of_find_entry_none Rbmap.not_mem_of_findEntry_none

theorem not_mem_of_find_none [IsStrictWeakOrder α lt] {k : α} {m : Rbmap α β lt} :
    m.find k = none → k ∉ m := by
  simp [find]; intro h
  have := eq_none_of_to_value_eq_none h
  exact not_mem_of_find_entry_none this
#align rbmap.not_mem_of_find_none Rbmap.not_mem_of_find_none

theorem mem_of_findEntry_some [IsStrictWeakOrder α lt] {k₁ : α} {e : α × β} {m : Rbmap α β lt} :
    m.findEntry k₁ = some e → k₁ ∈ m := by
  cases' m with t p; cases t <;> simp [find_entry, false_imp_iff]
  all_goals intro h; exact Rbtree.mem_of_find_some h
#align rbmap.mem_of_find_entry_some Rbmap.mem_of_findEntry_some

theorem mem_of_find_some [IsStrictWeakOrder α lt] {k : α} {v : β} {m : Rbmap α β lt} :
    m.find k = some v → k ∈ m := by
  simp [find]; intro h
  have := eq_some_of_to_value_eq_some h
  cases' this with _ he
  exact mem_of_find_entry_some he
#align rbmap.mem_of_find_some Rbmap.mem_of_find_some

theorem findEntry_eq_findEntry_of_eqv [IsStrictWeakOrder α lt] {m : Rbmap α β lt} {k₁ k₂ : α} :
    k₁ ≈[lt]k₂ → m.findEntry k₁ = m.findEntry k₂ :=
  by
  intro h; cases' m with t p; cases t <;> simp [find_entry]
  all_goals apply Rbtree.find_eq_find_of_eqv; apply eqv_entries_of_eqv_keys; assumption
#align rbmap.find_entry_eq_find_entry_of_eqv Rbmap.findEntry_eq_findEntry_of_eqv

theorem find_eq_find_of_eqv [IsStrictWeakOrder α lt] {k₁ k₂ : α} (m : Rbmap α β lt) :
    k₁ ≈[lt]k₂ → m.find k₁ = m.find k₂ := by intro h; simp [find]; apply congr_arg;
  apply find_entry_eq_find_entry_of_eqv; assumption
#align rbmap.find_eq_find_of_eqv Rbmap.find_eq_find_of_eqv

theorem findEntry_correct [IsStrictWeakOrder α lt] (k : α) (m : Rbmap α β lt) :
    k ∈ m ↔ ∃ e, m.findEntry k = some e ∧ k ≈[lt]e.1 :=
  by
  apply Iff.intro <;> cases' m with t p
  · intro h
    have h := to_rbtree_mem h
    cases' h with v h₁
    have hex := Iff.mp (Rbtree.find_correct _ _) h₁
    cases' hex with e h₂
    exists e
    cases t <;> simp [find_entry] at h₂⊢
    · simp [Rbtree.find, Rbnode.find] at h₂
      cases h₂
    · cases' h₂ with h₂₁ h₂₂
      constructor
      · have :=
          Rbtree.find_eq_find_of_eqv ⟨Rbnode.red_node t_lchild t_val t_rchild, p⟩
            (eqv_entries k v t_val.2)
        rw [← this]
        exact h₂₁
      · cases e
        apply eqv_keys_of_eqv_entries h₂₂
    · cases' h₂ with h₂₁ h₂₂
      constructor
      · have :=
          Rbtree.find_eq_find_of_eqv ⟨Rbnode.black_node t_lchild t_val t_rchild, p⟩
            (eqv_entries k v t_val.2)
        rw [← this]
        exact h₂₁
      · cases e
        apply eqv_keys_of_eqv_entries h₂₂
  · intro h
    cases' h with e h
    cases' h with h₁ h₂
    cases t <;> simp [find_entry] at h₁
    · contradiction
    all_goals exact to_rbmap_mem (Rbtree.mem_of_find_some h₁)
#align rbmap.find_entry_correct Rbmap.findEntry_correct

theorem eqv_of_findEntry_some [IsStrictWeakOrder α lt] {k₁ k₂ : α} {v : β} {m : Rbmap α β lt} :
    m.findEntry k₁ = some (k₂, v) → k₁ ≈[lt]k₂ :=
  by
  cases' m with t p; cases t <;> simp [find_entry, false_imp_iff]
  all_goals intro h; exact eqv_keys_of_eqv_entries (Rbtree.eqv_of_find_some h)
#align rbmap.eqv_of_find_entry_some Rbmap.eqv_of_findEntry_some

theorem eq_of_findEntry_some [IsStrictTotalOrder α lt] {k₁ k₂ : α} {v : β} {m : Rbmap α β lt} :
    m.findEntry k₁ = some (k₂, v) → k₁ = k₂ := fun h =>
  suffices k₁ ≈[lt]k₂ from eq_of_eqv_lt this
  eqv_of_findEntry_some h
#align rbmap.eq_of_find_entry_some Rbmap.eq_of_findEntry_some

theorem find_correct [IsStrictWeakOrder α lt] (k : α) (m : Rbmap α β lt) :
    k ∈ m ↔ ∃ v, m.find k = some v := by
  apply Iff.intro
  · intro h
    have := Iff.mp (find_entry_correct k m) h
    cases' this with e h
    cases' h with h₁ h₂
    exists e.2
    simp [find, h₁, to_value]
  · intro h
    cases' h with v h
    simp [find] at h
    have h := eq_some_of_to_value_eq_some h
    cases' h with k' h
    have heqv := eqv_of_find_entry_some h
    exact Iff.mpr (find_entry_correct k m) ⟨(k', v), ⟨h, heqv⟩⟩
#align rbmap.find_correct Rbmap.find_correct

theorem constains_correct [IsStrictWeakOrder α lt] (k : α) (m : Rbmap α β lt) :
    k ∈ m ↔ m.contains k = true := by
  apply Iff.intro
  · intro h
    have h := Iff.mp (find_entry_correct k m) h
    cases' h with e h
    cases' h with h₁ h₂
    simp [contains, h₁, Option.isSome]
  · simp [contains]
    intro h
    generalize he : find_entry m k = e
    cases e
    · simp [he, Option.isSome] at h
      contradiction
    · exact mem_of_find_entry_some he
#align rbmap.constains_correct Rbmap.constains_correct

theorem mem_insert_of_incomp [IsStrictWeakOrder α lt] {k₁ k₂ : α} (m : Rbmap α β lt) (v : β) :
    ¬lt k₁ k₂ ∧ ¬lt k₂ k₁ → k₁ ∈ m.insert k₂ v := fun h =>
  to_rbmap_mem (Rbtree.mem_insert_of_incomp m (eqv_entries_of_eqv_keys v v h))
#align rbmap.mem_insert_of_incomp Rbmap.mem_insert_of_incomp

theorem mem_insert [IsStrictWeakOrder α lt] (k : α) (m : Rbmap α β lt) (v : β) : k ∈ m.insert k v :=
  to_rbmap_mem (Rbtree.mem_insert (k, v) m)
#align rbmap.mem_insert Rbmap.mem_insert

theorem mem_insert_of_equiv [IsStrictWeakOrder α lt] {k₁ k₂ : α} (m : Rbmap α β lt) (v : β) :
    k₁ ≈[lt]k₂ → k₁ ∈ m.insert k₂ v :=
  mem_insert_of_incomp m v
#align rbmap.mem_insert_of_equiv Rbmap.mem_insert_of_equiv

theorem mem_insert_of_mem [IsStrictWeakOrder α lt] {k₁ : α} {m : Rbmap α β lt} (k₂ : α) (v : β) :
    k₁ ∈ m → k₁ ∈ m.insert k₂ v := fun h =>
  to_rbmap_mem (Rbtree.mem_insert_of_mem (k₂, v) (to_rbtree_mem' v h))
#align rbmap.mem_insert_of_mem Rbmap.mem_insert_of_mem

theorem equiv_or_mem_of_mem_insert [IsStrictWeakOrder α lt] {k₁ k₂ : α} {v : β} {m : Rbmap α β lt} :
    k₁ ∈ m.insert k₂ v → k₁ ≈[lt]k₂ ∨ k₁ ∈ m := fun h =>
  Or.elim (Rbtree.equiv_or_mem_of_mem_insert (to_rbtree_mem' v h))
    (fun h => Or.inl (eqv_keys_of_eqv_entries h)) fun h => Or.inr (to_rbmap_mem h)
#align rbmap.equiv_or_mem_of_mem_insert Rbmap.equiv_or_mem_of_mem_insert

theorem incomp_or_mem_of_mem_ins [IsStrictWeakOrder α lt] {k₁ k₂ : α} {v : β} {m : Rbmap α β lt} :
    k₁ ∈ m.insert k₂ v → ¬lt k₁ k₂ ∧ ¬lt k₂ k₁ ∨ k₁ ∈ m :=
  equiv_or_mem_of_mem_insert
#align rbmap.incomp_or_mem_of_mem_ins Rbmap.incomp_or_mem_of_mem_ins

theorem eq_or_mem_of_mem_ins [IsStrictTotalOrder α lt] {k₁ k₂ : α} {v : β} {m : Rbmap α β lt} :
    k₁ ∈ m.insert k₂ v → k₁ = k₂ ∨ k₁ ∈ m := fun h =>
  suffices k₁ ≈[lt]k₂ ∨ k₁ ∈ m by simp [eqv_lt_iff_eq] at this <;> assumption
  incomp_or_mem_of_mem_ins h
#align rbmap.eq_or_mem_of_mem_ins Rbmap.eq_or_mem_of_mem_ins

theorem findEntry_insert_of_eqv [IsStrictWeakOrder α lt] (m : Rbmap α β lt) {k₁ k₂ : α} (v : β) :
    k₁ ≈[lt]k₂ → (m.insert k₁ v).findEntry k₂ = some (k₁, v) :=
  by
  intro h
  generalize h₁ : m.insert k₁ v = m'
  cases' m' with t p; cases t
  · have := mem_insert k₁ m v
    rw [h₁] at this
    apply absurd this
    apply not_mem_mk_rbmap
  all_goals
    simp [find_entry]; rw [← h₁, insert]; apply Rbtree.find_insert_of_eqv
    apply eqv_entries_of_eqv_keys _ _ h
#align rbmap.find_entry_insert_of_eqv Rbmap.findEntry_insert_of_eqv

theorem findEntry_insert [IsStrictWeakOrder α lt] (m : Rbmap α β lt) (k : α) (v : β) :
    (m.insert k v).findEntry k = some (k, v) :=
  findEntry_insert_of_eqv m v (refl k)
#align rbmap.find_entry_insert Rbmap.findEntry_insert

theorem find_insert_of_eqv [IsStrictWeakOrder α lt] (m : Rbmap α β lt) {k₁ k₂ : α} (v : β) :
    k₁ ≈[lt]k₂ → (m.insert k₁ v).find k₂ = some v :=
  by
  intro h
  have := find_entry_insert_of_eqv m v h
  simp [find, this, to_value]
#align rbmap.find_insert_of_eqv Rbmap.find_insert_of_eqv

theorem find_insert [IsStrictWeakOrder α lt] (m : Rbmap α β lt) (k : α) (v : β) :
    (m.insert k v).find k = some v :=
  find_insert_of_eqv m v (refl k)
#align rbmap.find_insert Rbmap.find_insert

theorem findEntry_insert_of_disj [IsStrictWeakOrder α lt] {k₁ k₂ : α} (m : Rbmap α β lt) (v : β) :
    lt k₁ k₂ ∨ lt k₂ k₁ → (m.insert k₁ v).findEntry k₂ = m.findEntry k₂ :=
  by
  intro h
  have h' : ∀ {v₁ v₂ : β}, (RbmapLt lt) (k₁, v₁) (k₂, v₂) ∨ (RbmapLt lt) (k₂, v₂) (k₁, v₁) :=
    fun _ _ => h
  generalize h₁ : m = m₁
  generalize h₂ : insert m₁ k₁ v = m₂
  rw [← h₁] at h₂⊢; rw [← h₂]
  cases' m₁ with t₁ p₁ <;> cases t₁ <;> cases' m₂ with t₂ p₂ <;> cases t₂
  · rw [h₂, h₁]
  iterate 2
    rw [h₂]
    conv =>
      lhs
      simp [find_entry]
    rw [← h₂, insert, Rbtree.find_insert_of_disj _ h', h₁]
    rfl
  any_goals
    simp [insert] at h₂
    exact absurd h₂ (Rbtree.insert_ne_mkRbtree m (k₁, v))
  any_goals
    rw [h₂, h₁]; simp [find_entry]; rw [← h₂, ← h₁, insert, Rbtree.find_insert_of_disj _ h']
    apply Rbtree.find_eq_find_of_eqv; apply eqv_entries
#align rbmap.find_entry_insert_of_disj Rbmap.findEntry_insert_of_disj

theorem findEntry_insert_of_not_eqv [IsStrictWeakOrder α lt] {k₁ k₂ : α} (m : Rbmap α β lt)
    (v : β) : ¬k₁ ≈[lt]k₂ → (m.insert k₁ v).findEntry k₂ = m.findEntry k₂ :=
  by
  intro hn
  have he : lt k₁ k₂ ∨ lt k₂ k₁ :=
    by
    simp [StrictWeakOrder.Equiv, Decidable.not_and_iff_or_not, Decidable.not_not_iff] at hn
    assumption
  apply find_entry_insert_of_disj _ _ he
#align rbmap.find_entry_insert_of_not_eqv Rbmap.findEntry_insert_of_not_eqv

theorem findEntry_insert_of_ne [IsStrictTotalOrder α lt] {k₁ k₂ : α} (m : Rbmap α β lt) (v : β) :
    k₁ ≠ k₂ → (m.insert k₁ v).findEntry k₂ = m.findEntry k₂ :=
  by
  intro h
  have : ¬k₁ ≈[lt]k₂ := fun h' => h (eq_of_eqv_lt h')
  apply find_entry_insert_of_not_eqv _ _ this
#align rbmap.find_entry_insert_of_ne Rbmap.findEntry_insert_of_ne

theorem find_insert_of_disj [IsStrictWeakOrder α lt] {k₁ k₂ : α} (m : Rbmap α β lt) (v : β) :
    lt k₁ k₂ ∨ lt k₂ k₁ → (m.insert k₁ v).find k₂ = m.find k₂ := by intro h;
  have := find_entry_insert_of_disj m v h; simp [find, this]
#align rbmap.find_insert_of_disj Rbmap.find_insert_of_disj

theorem find_insert_of_not_eqv [IsStrictWeakOrder α lt] {k₁ k₂ : α} (m : Rbmap α β lt) (v : β) :
    ¬k₁ ≈[lt]k₂ → (m.insert k₁ v).find k₂ = m.find k₂ := by intro h;
  have := find_entry_insert_of_not_eqv m v h; simp [find, this]
#align rbmap.find_insert_of_not_eqv Rbmap.find_insert_of_not_eqv

theorem find_insert_of_ne [IsStrictTotalOrder α lt] {k₁ k₂ : α} (m : Rbmap α β lt) (v : β) :
    k₁ ≠ k₂ → (m.insert k₁ v).find k₂ = m.find k₂ := by intro h;
  have := find_entry_insert_of_ne m v h; simp [find, this]
#align rbmap.find_insert_of_ne Rbmap.find_insert_of_ne

end Decidable

theorem mem_of_min_eq [IsStrictTotalOrder α lt] {k : α} {v : β} {m : Rbmap α β lt} :
    m.min = some (k, v) → k ∈ m := fun h => to_rbmap_mem (Rbtree.mem_of_min_eq h)
#align rbmap.mem_of_min_eq Rbmap.mem_of_min_eq

theorem mem_of_max_eq [IsStrictTotalOrder α lt] {k : α} {v : β} {m : Rbmap α β lt} :
    m.max = some (k, v) → k ∈ m := fun h => to_rbmap_mem (Rbtree.mem_of_max_eq h)
#align rbmap.mem_of_max_eq Rbmap.mem_of_max_eq

theorem eq_leaf_of_min_eq_none {m : Rbmap α β lt} : m.min = none → m = mkRbmap α β lt :=
  Rbtree.eq_leaf_of_min_eq_none
#align rbmap.eq_leaf_of_min_eq_none Rbmap.eq_leaf_of_min_eq_none

theorem eq_leaf_of_max_eq_none {m : Rbmap α β lt} : m.max = none → m = mkRbmap α β lt :=
  Rbtree.eq_leaf_of_max_eq_none
#align rbmap.eq_leaf_of_max_eq_none Rbmap.eq_leaf_of_max_eq_none

theorem min_is_minimal [IsStrictWeakOrder α lt] {k : α} {v : β} {m : Rbmap α β lt} :
    m.min = some (k, v) → ∀ {k'}, k' ∈ m → k ≈[lt]k' ∨ lt k k' := fun h k' hm =>
  Or.elim (Rbtree.min_is_minimal h (to_rbtree_mem' v hm))
    (fun h => Or.inl (eqv_keys_of_eqv_entries h)) fun h => Or.inr h
#align rbmap.min_is_minimal Rbmap.min_is_minimal

theorem max_is_maximal [IsStrictWeakOrder α lt] {k : α} {v : β} {m : Rbmap α β lt} :
    m.max = some (k, v) → ∀ {k'}, k' ∈ m → k ≈[lt]k' ∨ lt k' k := fun h k' hm =>
  Or.elim (Rbtree.max_is_maximal h (to_rbtree_mem' v hm))
    (fun h => Or.inl (eqv_keys_of_eqv_entries h)) fun h => Or.inr h
#align rbmap.max_is_maximal Rbmap.max_is_maximal

theorem min_is_minimal_of_total [IsStrictTotalOrder α lt] {k : α} {v : β} {m : Rbmap α β lt} :
    m.min = some (k, v) → ∀ {k'}, k' ∈ m → k = k' ∨ lt k k' := fun h k' hm =>
  match min_is_minimal h hm with
  | Or.inl h => Or.inl (eq_of_eqv_lt h)
  | Or.inr h => Or.inr h
#align rbmap.min_is_minimal_of_total Rbmap.min_is_minimal_of_total

theorem max_is_maximal_of_total [IsStrictTotalOrder α lt] {k : α} {v : β} {m : Rbmap α β lt} :
    m.max = some (k, v) → ∀ {k'}, k' ∈ m → k = k' ∨ lt k' k := fun h k' hm =>
  match max_is_maximal h hm with
  | Or.inl h => Or.inl (eq_of_eqv_lt h)
  | Or.inr h => Or.inr h
#align rbmap.max_is_maximal_of_total Rbmap.max_is_maximal_of_total

end Rbmap


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.multiset.nodup
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# The cartesian product of multisets
-/

namespace multiset

/-- Given `δ : α → Type*`, `pi.empty δ` is the trivial dependent function out of the empty
multiset. -/
def pi.empty {α : Type u_1} (δ : α → Type u_2) (a : α) (H : a ∈ 0) : δ a := sorry

/-- Given `δ : α → Type*`, a multiset `m` and a term `a`, as well as a term `b : δ a` and a
function `f` such that `f a' : δ a'` for all `a'` in `m`, `pi.cons m a b f` is a function `g` such
that `g a'' : δ a''` for all `a''` in `a ::ₘ m`. -/
def pi.cons {α : Type u_1} [DecidableEq α] {δ : α → Type u_2} (m : multiset α) (a : α) (b : δ a)
    (f : (a : α) → a ∈ m → δ a) (a' : α) (H : a' ∈ a ::ₘ m) : δ a' :=
  dite (a' = a) (fun (h : a' = a) => Eq._oldrec b (Eq.symm h)) fun (h : ¬a' = a) => f a' sorry

theorem pi.cons_same {α : Type u_1} [DecidableEq α] {δ : α → Type u_2} {m : multiset α} {a : α}
    {b : δ a} {f : (a : α) → a ∈ m → δ a} (h : a ∈ a ::ₘ m) : pi.cons m a b f a h = b :=
  dif_pos rfl

theorem pi.cons_ne {α : Type u_1} [DecidableEq α] {δ : α → Type u_2} {m : multiset α} {a : α}
    {a' : α} {b : δ a} {f : (a : α) → a ∈ m → δ a} (h' : a' ∈ a ::ₘ m) (h : a' ≠ a) :
    pi.cons m a b f a' h' = f a' (or.resolve_left (iff.mp mem_cons h') h) :=
  dif_neg h

theorem pi.cons_swap {α : Type u_1} [DecidableEq α] {δ : α → Type u_2} {a : α} {a' : α} {b : δ a}
    {b' : δ a'} {m : multiset α} {f : (a : α) → a ∈ m → δ a} (h : a ≠ a') :
    pi.cons (a' ::ₘ m) a b (pi.cons m a' b' f) == pi.cons (a ::ₘ m) a' b' (pi.cons m a b f) :=
  sorry

/-- `pi m t` constructs the Cartesian product over `t` indexed by `m`. -/
def pi {α : Type u_1} [DecidableEq α] {δ : α → Type u_2} (m : multiset α)
    (t : (a : α) → multiset (δ a)) : multiset ((a : α) → a ∈ m → δ a) :=
  multiset.rec_on m (singleton sorry)
    (fun (a : α) (m : multiset α) (p : multiset ((a : α) → a ∈ m → δ a)) =>
      bind (t a) fun (b : δ a) => map sorry p)
    sorry

@[simp] theorem pi_zero {α : Type u_1} [DecidableEq α] {δ : α → Type u_2}
    (t : (a : α) → multiset (δ a)) : pi 0 t = pi.empty δ ::ₘ 0 :=
  rfl

@[simp] theorem pi_cons {α : Type u_1} [DecidableEq α] {δ : α → Type u_2} (m : multiset α)
    (t : (a : α) → multiset (δ a)) (a : α) :
    pi (a ::ₘ m) t = bind (t a) fun (b : δ a) => map (pi.cons m a b) (pi m t) :=
  rec_on_cons a m

theorem pi_cons_injective {α : Type u_1} [DecidableEq α] {δ : α → Type u_2} {a : α} {b : δ a}
    {s : multiset α} (hs : ¬a ∈ s) : function.injective (pi.cons s a b) :=
  sorry

theorem card_pi {α : Type u_1} [DecidableEq α] {δ : α → Type u_2} (m : multiset α)
    (t : (a : α) → multiset (δ a)) :
    coe_fn card (pi m t) = prod (map (fun (a : α) => coe_fn card (t a)) m) :=
  sorry

theorem nodup_pi {α : Type u_1} [DecidableEq α] {δ : α → Type u_2} {s : multiset α}
    {t : (a : α) → multiset (δ a)} : nodup s → (∀ (a : α), a ∈ s → nodup (t a)) → nodup (pi s t) :=
  sorry

theorem mem_pi {α : Type u_1} [DecidableEq α] {δ : α → Type u_2} (m : multiset α)
    (t : (a : α) → multiset (δ a)) (f : (a : α) → a ∈ m → δ a) :
    f ∈ pi m t ↔ ∀ (a : α) (h : a ∈ m), f a h ∈ t a :=
  sorry

end Mathlib


example (P Q R S T U: Type) (p: P) (h: P → Q) (i: Q → R) (j: Q → T) (k: S → T) (l: T → U) : U :=
begin
    apply l,
    apply j,
    apply h,
    exact p,
end


/-
Copyright (c) 2019 Lucas Allen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Lucas Allen, Scott Morrison
-/
import data.mllist
import tactic.solve_by_elim

/-!
# `suggest` and `library_search`

`suggest` and `library_search` are a pair of tactics for applying lemmas from the library to the
current goal.

* `suggest` prints a list of `exact ...` or `refine ...` statements, which may produce new goals
* `library_search` prints a single `exact ...` which closes the goal, or fails
-/

namespace tactic

open native

namespace suggest

open solve_by_elim

/-- Map a name (typically a head symbol) to a "canonical" definitional synonym.
Given a name `n`, we want a name `n'` such that a sufficiently applied
expression with head symbol `n` is always definitionally equal to an expression
with head symbol `n'`.
Thus, we can search through all lemmas with a result type of `n'`
to solve a goal with head symbol `n`.

For example, `>` is mapped to `<` because `a > b` is definitionally equal to `b < a`,
and `not` is mapped to `false` because `¬ a` is definitionally equal to `p → false`
The default is that the original argument is returned, so `<` is just mapped to `<`.

`normalize_synonym` is called for every lemma in the library, so it needs to be fast.
-/
-- TODO this is a hack; if you suspect more cases here would help, please report them
meta def normalize_synonym : name → name
| `gt := `has_lt.lt
| `ge := `has_le.le
| `monotone := `has_le.le
| `not := `false
| n   := n

/--
Compute the head symbol of an expression, then normalise synonyms.

This is only used when analysing the goal, so it is okay to do more expensive analysis here.
-/
-- We may want to tweak this further?
meta def allowed_head_symbols : expr → list name
-- We first have a various "customisations":
--   Because in `ℕ` `a.succ ≤ b` is definitionally `a < b`,
--   we add some special cases to allow looking for `<` lemmas even when the goal has a `≤`.
--   Note we only do this in the `ℕ` case, for performance.
| `(@has_le.le ℕ _ (nat.succ _) _) := [`has_le.le, `has_lt.lt]
| `(@ge ℕ _ _ (nat.succ _)) := [`has_le.le, `has_lt.lt]
| `(@has_le.le ℕ _ 1 _) := [`has_le.le, `has_lt.lt]
| `(@ge ℕ _ _ 1) := [`has_le.le, `has_lt.lt]

-- And then the generic cases:
| (expr.pi _ _ _ t) := allowed_head_symbols t
| (expr.app f _) := allowed_head_symbols f
| (expr.const n _) := [normalize_synonym n]
| _ := [`_]
.

/--
A declaration can match the head symbol of the current goal in four possible ways:
* `ex`  : an exact match
* `mp`  : the declaration returns an `iff`, and the right hand side matches the goal
* `mpr` : the declaration returns an `iff`, and the left hand side matches the goal
* `both`: the declaration returns an `iff`, and the both sides match the goal
-/
@[derive decidable_eq, derive inhabited]
inductive head_symbol_match
| ex | mp | mpr | both

open head_symbol_match

/-- a textual representation of a `head_symbol_match`, for trace debugging. -/
def head_symbol_match.to_string : head_symbol_match → string
| ex   := "exact"
| mp   := "iff.mp"
| mpr  := "iff.mpr"
| both := "iff.mp and iff.mpr"

/-- Determine if, and in which way, a given expression matches the specified head symbol. -/
meta def match_head_symbol (hs : name_set) : expr → option head_symbol_match
| (expr.pi _ _ _ t) := match_head_symbol t
| `(%%a ↔ %%b)      := if hs.contains `iff then some ex else
                       match (match_head_symbol a, match_head_symbol b) with
                       | (some ex, some ex) :=
                           some both
                       | (some ex, _) := some mpr
                       | (_, some ex) := some mp
                       | _ := none
                       end
| (expr.app f _)    := match_head_symbol f
| (expr.const n _)  := if hs.contains (normalize_synonym n) then some ex else none
| _ := if hs.contains `_ then some ex else none

/-- A package of `declaration` metadata, including the way in which its type matches the head symbol
which we are searching for. -/
meta structure decl_data :=
(d : declaration)
(n : name)
(m : head_symbol_match)
(l : ℕ) -- cached length of name

/--
Generate a `decl_data` from the given declaration if
it matches the head symbol `hs` for the current goal.
-/
-- We used to check here for private declarations, or declarations with certain suffixes.
-- It turns out `apply` is so fast, it's better to just try them all.
meta def process_declaration (hs : name_set) (d : declaration) : option decl_data :=
let n := d.to_name in
if !d.is_trusted || n.is_internal then
  none
else
  (λ m, ⟨d, n, m, n.length⟩) <$> match_head_symbol hs d.type

/-- Retrieve all library definitions with a given head symbol. -/
meta def library_defs (hs : name_set) : tactic (list decl_data) :=
do trace_if_enabled `suggest format!"Looking for lemmas with head symbols {hs}.",
   env ← get_env,
   let defs := env.decl_filter_map (process_declaration hs),
   -- Sort by length; people like short proofs
   let defs := defs.qsort(λ d₁ d₂, d₁.l ≤ d₂.l),
   trace_if_enabled `suggest format!"Found {defs.length} relevant lemmas:",
   trace_if_enabled `suggest $ defs.map (λ ⟨d, n, m, l⟩, (n, m.to_string)),
   return defs

/--
We unpack any element of a list of `decl_data` corresponding to an `↔` statement that could apply
in both directions into two separate elements.

This ensures that both directions can be independently returned by `suggest`,
and avoids a problem where the application of one direction prevents
the application of the other direction. (See `exp_le_exp` in the tests.)
-/
meta def unpack_iff_both : list decl_data → list decl_data
| []                     := []
| (⟨d, n, both, l⟩ :: L) := ⟨d, n, mp, l⟩ :: ⟨d, n, mpr, l⟩ :: unpack_iff_both L
| (⟨d, n, m, l⟩ :: L)    := ⟨d, n, m, l⟩ :: unpack_iff_both L

/--
Apply the lemma `e`, then attempt to close all goals using
`solve_by_elim opt`, failing if `close_goals = tt`
and there are any goals remaining.

Returns the number of subgoals which were closed using `solve_by_elim`.
-/
-- Implementation note: as this is used by both `library_search` and `suggest`,
-- we first run `solve_by_elim` separately on the independent goals,
-- whether or not `close_goals` is set,
-- and then run `solve_by_elim { all_goals := tt }`,
-- requiring that it succeeds if `close_goals = tt`.
meta def apply_and_solve (close_goals : bool) (opt : opt := { }) (e : expr) : tactic ℕ :=
do
  trace_if_enabled `suggest format!"Trying to apply lemma: {e}",
  apply e opt.to_apply_cfg,
  trace_if_enabled `suggest format!"Applied lemma: {e}",
  ng ← num_goals,
  -- Phase 1
  -- Run `solve_by_elim` on each "safe" goal separately, not worrying about failures.
  -- (We only attempt the "safe" goals in this way in Phase 1. In Phase 2 we will do
  -- backtracking search across all goals, allowing us to guess solutions that involve data, or
  -- unify metavariables, but only as long as we can finish all goals.)
  try (any_goals (independent_goal >> solve_by_elim opt)),
  -- Phase 2
  (done >> return ng) <|> (do
    -- If there were any goals that we did not attempt solving in the first phase
    -- (because they weren't propositional, or contained a metavariable)
    -- as a second phase we attempt to solve all remaining goals at once
    -- (with backtracking across goals).
    (any_goals (success_if_fail independent_goal) >>
    solve_by_elim { backtrack_all_goals := tt, ..opt }) <|>
    -- and fail unless `close_goals = ff`
    guard ¬ close_goals,
    ng' ← num_goals,
    return (ng - ng'))

/--
Apply the declaration `d` (or the forward and backward implications separately, if it is an `iff`),
and then attempt to solve the subgoal using `apply_and_solve`.

Returns the number of subgoals successfully closed.
-/
meta def apply_declaration (close_goals : bool) (opt : opt := { }) (d : decl_data) :
  tactic ℕ :=
let tac := apply_and_solve close_goals opt in
do (e, t) ← decl_mk_const d.d,
   match d.m with
   | ex   := tac e
   | mp   := do l ← iff_mp_core e t, tac l
   | mpr  := do l ← iff_mpr_core e t, tac l
   | both := undefined -- we use `unpack_iff_both` to ensure this isn't reachable
   end

/-- An `application` records the result of a successful application of a library lemma. -/
meta structure application :=
(state     : tactic_state)
(script    : string)
(decl      : option declaration)
(num_goals : ℕ)
(hyps_used : ℕ)

end suggest

open solve_by_elim
open suggest

declare_trace suggest         -- Trace a list of all relevant lemmas

-- Call `apply_declaration`, then prepare the tactic script and
-- count the number of local hypotheses used.
private meta def apply_declaration_script
  (g : expr) (hyps : list expr)
  (opt : opt := { })
  (d : decl_data) :
  tactic application :=
-- (This tactic block is only executed when we evaluate the mllist,
-- so we need to do the `focus1` here.)
retrieve $ focus1 $ do
  apply_declaration ff opt d,
  ng ← num_goals,
  -- This `instantiate_mvars` is necessary so that we count used hypotheses correctly.
  g ← instantiate_mvars g,
  s ← read,
  m ← tactic_statement g,
  return
  { application .
    state := s,
    decl := d.d,
    script := m,
    num_goals := ng,
    hyps_used := hyps.countp (λ h, h.occurs g) }

-- implementation note: we produce a `tactic (mllist tactic application)` first,
-- because it's easier to work in the tactic monad, but in a moment we squash this
-- down to an `mllist tactic application`.
private meta def suggest_core' (opt : opt := { }) :
  tactic (mllist tactic application) :=
do g :: _ ← get_goals,
   hyps ← local_context,

   -- Make sure that `solve_by_elim` doesn't just solve the goal immediately:
   (retrieve (do
     focus1 $ solve_by_elim opt,
     s ← read,
     m ← tactic_statement g,
     -- This `instantiate_mvars` is necessary so that we count used hypotheses correctly.
     g ← instantiate_mvars g,
     return $ mllist.of_list [⟨s, m, none, 0, hyps.countp (λ h, h.occurs g)⟩])) <|>
   -- Otherwise, let's actually try applying library lemmas.
   (do
   -- Collect all definitions with the correct head symbol
   t ← infer_type g,
   defs ← unpack_iff_both <$> library_defs (name_set.of_list $ allowed_head_symbols t),

   let defs : mllist tactic _ := mllist.of_list defs,

   -- Try applying each lemma against the goal,
   -- recording the tactic script as a string,
   -- the number of remaining goals,
   -- and number of local hypotheses used.
   let results := defs.mfilter_map (apply_declaration_script g hyps opt),
   -- Now call `symmetry` and try again.
   -- (Because we are using `mllist`, this is essentially free if we've already found a lemma.)
   symm_state ← retrieve $ try_core $ symmetry >> read,
   let results_symm := match symm_state with
   | (some s) :=
     defs.mfilter_map (λ d, retrieve $ set_state s >> apply_declaration_script g hyps opt d)
   | none := mllist.nil
   end,
  return (results.append results_symm))

/--
The core `suggest` tactic.
It attempts to apply a declaration from the library,
then solve new goals using `solve_by_elim`.

It returns a list of `application`s consisting of fields:
* `state`, a tactic state resulting from the successful application of a declaration from
  the library,
* `script`, a string of the form `Try this: refine ...` or `Try this: exact ...` which will
  reproduce that tactic state,
* `decl`, an `option declaration` indicating the declaration that was applied
  (or none, if `solve_by_elim` succeeded),
* `num_goals`, the number of remaining goals, and
* `hyps_used`, the number of local hypotheses used in the solution.
-/
meta def suggest_core (opt : opt := { }) : mllist tactic application :=
(mllist.monad_lift (suggest_core' opt)).join

/--
See `suggest_core`.

Returns a list of at most `limit` `application`s,
sorted by number of goals, and then (reverse) number of hypotheses used.
-/
meta def suggest (limit : option ℕ := none) (opt : opt := { }) :
  tactic (list application) :=
do let results := suggest_core opt,
   -- Get the first n elements of the successful lemmas
   L ← if h : limit.is_some then results.take (option.get h) else results.force,
   -- Sort by number of remaining goals, then by number of hypotheses used.
   return $ L.qsort (λ d₁ d₂, d₁.num_goals < d₂.num_goals ∨
    (d₁.num_goals = d₂.num_goals ∧ d₁.hyps_used ≥ d₂.hyps_used))

/--
Returns a list of at most `limit` strings, of the form `Try this: exact ...` or
`Try this: refine ...`, which make progress on the current goal using a declaration
from the library.
-/
meta def suggest_scripts (limit : option ℕ := none) (opt : opt := { }) :
  tactic (list string) :=
do L ← suggest limit opt,
   return $ L.map application.script

/--
Returns a string of the form `Try this: exact ...`, which closes the current goal.
-/
meta def library_search (opt : opt := { }) : tactic string :=
(suggest_core opt).mfirst (λ a, do guard (a.num_goals = 0), write a.state, return a.script)

namespace interactive
open tactic
open interactive
open lean.parser
open interactive.types
open solve_by_elim
local postfix `?`:9001 := optional

declare_trace silence_suggest -- Turn off `Try this: exact/refine ...` trace messages for `suggest`

/--
`suggest` tries to apply suitable theorems/defs from the library, and generates
a list of `exact ...` or `refine ...` scripts that could be used at this step.
It leaves the tactic state unchanged. It is intended as a complement of the search
function in your editor, the `#find` tactic, and `library_search`.

`suggest` takes an optional natural number `num` as input and returns the first `num`
(or less, if all possibilities are exhausted) possibilities ordered by length of lemma names.
The default for `num` is `50`.
For performance reasons `suggest` uses monadic lazy lists (`mllist`). This means that
`suggest` might miss some results if `num` is not large enough. However, because
`suggest` uses monadic lazy lists, smaller values of `num` run faster than larger values.

You can add additional lemmas to be used along with local hypotheses
after the application of a library lemma,
using the same syntax as for `solve_by_elim`, e.g.
```
example {a b c d: nat} (h₁ : a < c) (h₂ : b < d) : max (c + d) (a + b) = (c + d) :=
begin
  suggest [add_lt_add], -- Says: `Try this: exact max_eq_left_of_lt (add_lt_add h₁ h₂)`
end
```
You can also use `suggest with attr` to include all lemmas with the attribute `attr`.
-/
meta def suggest (n : parse (with_desc "n" small_nat)?)
  (hs : parse simp_arg_list) (attr_names : parse with_ident_list) (opt : opt := { }) :
  tactic unit :=
do (lemma_thunks, ctx_thunk) ← mk_assumption_set ff hs attr_names,
   L ← tactic.suggest_scripts (n.get_or_else 50)
     { lemma_thunks := some lemma_thunks, ctx_thunk := ctx_thunk, ..opt },
  if is_trace_enabled_for `silence_suggest then
    skip
  else
    if L.length = 0 then
      fail "There are no applicable declarations"
    else
      L.mmap trace >> skip

/--
`suggest` lists possible usages of the `refine` tactic and leaves the tactic state unchanged.
It is intended as a complement of the search function in your editor, the `#find` tactic, and
`library_search`.

`suggest` takes an optional natural number `num` as input and returns the first `num` (or less, if
all possibilities are exhausted) possibilities ordered by length of lemma names.
The default for `num` is `50`.

For performance reasons `suggest` uses monadic lazy lists (`mllist`). This means that `suggest`
might miss some results if `num` is not large enough. However, because `suggest` uses monadic
lazy lists, smaller values of `num` run faster than larger values.

An example of `suggest` in action,

```lean
example (n : nat) : n < n + 1 :=
begin suggest, sorry end
```

prints the list,

```lean
Try this: exact nat.lt.base n
Try this: exact nat.lt_succ_self n
Try this: refine not_le.mp _
Try this: refine gt_iff_lt.mp _
Try this: refine nat.lt.step _
Try this: refine lt_of_not_ge _
...
```
-/
add_tactic_doc
{ name        := "suggest",
  category    := doc_category.tactic,
  decl_names  := [`tactic.interactive.suggest],
  tags        := ["search", "Try this"] }

-- Turn off `Try this: exact ...` trace message for `library_search`
declare_trace silence_library_search

/--
`library_search` is a tactic to identify existing lemmas in the library. It tries to close the
current goal by applying a lemma from the library, then discharging any new goals using
`solve_by_elim`.

If it succeeds, it prints a trace message `exact ...` which can replace the invocation
of `library_search`.

Typical usage is:
```lean
example (n m k : ℕ) : n * (m - k) = n * m - n * k :=
by library_search -- Try this: exact nat.mul_sub_left_distrib n m k
```

By default `library_search` only unfolds `reducible` definitions
when attempting to match lemmas against the goal.
Previously, it would unfold most definitions, sometimes giving surprising answers, or slow answers.
The old behaviour is still available via `library_search!`.

You can add additional lemmas to be used along with local hypotheses
after the application of a library lemma,
using the same syntax as for `solve_by_elim`, e.g.
```
example {a b c d: nat} (h₁ : a < c) (h₂ : b < d) : max (c + d) (a + b) = (c + d) :=
begin
  library_search [add_lt_add], -- Says: `Try this: exact max_eq_left_of_lt (add_lt_add h₁ h₂)`
end
```
You can also use `library_search with attr` to include all lemmas with the attribute `attr`.
-/
meta def library_search (semireducible : parse $ optional (tk "!"))
  (hs : parse simp_arg_list) (attr_names : parse with_ident_list)
  (opt : opt := { }) : tactic unit :=
do (lemma_thunks, ctx_thunk) ← mk_assumption_set ff hs attr_names,
   (tactic.library_search
     { backtrack_all_goals := tt,
       lemma_thunks := some lemma_thunks,
       ctx_thunk := ctx_thunk,
       md := if semireducible.is_some then
         tactic.transparency.semireducible else tactic.transparency.reducible,
       ..opt } >>=
   if is_trace_enabled_for `silence_library_search then
     (λ _, skip)
   else
     trace) <|>
   fail
"`library_search` failed.
If you aren't sure what to do next, you can also
try `library_search!`, `suggest`, or `hint`.

Possible reasons why `library_search` failed:
* `library_search` will only apply a single lemma from the library,
  and then try to fill in its hypotheses from local hypotheses.
* If you haven't already, try stating the theorem you want in its own lemma.
* Sometimes the library has one version of a lemma
  but not a very similar version obtained by permuting arguments.
  Try replacing `a + b` with `b + a`, or `a - b < c` with `a < b + c`,
  to see if maybe the lemma exists but isn't stated quite the way you would like.
* Make sure that you have all the side conditions for your theorem to be true.
  For example you won't find `a - b + b = a` for natural numbers in the library because it's false!
  Search for `b ≤ a → a - b + b = a` instead.
* If a definition you made is in the goal,
  you won't find any theorems about it in the library.
  Try unfolding the definition using `unfold my_definition`.
* If all else fails, ask on https://leanprover.zulipchat.com/,
  and maybe we can improve the library and/or `library_search` for next time."

add_tactic_doc
{ name        := "library_search",
  category    := doc_category.tactic,
  decl_names  := [`tactic.interactive.library_search],
  tags        := ["search", "Try this"] }

end interactive

/-- Invoking the hole command `library_search` ("Use `library_search` to complete the goal") calls
the tactic `library_search` to produce a proof term with the type of the hole.

Running it on

```lean
example : 0 < 1 :=
{!!}
```

produces

```lean
example : 0 < 1 :=
nat.one_pos
```
-/
@[hole_command] meta def library_search_hole_cmd : hole_command :=
{ name := "library_search",
  descr := "Use `library_search` to complete the goal.",
  action := λ _, do
    script ← library_search,
    -- Is there a better API for dropping the 'Try this: exact ' prefix on this string?
    return [((script.get_rest "Try this: exact ").get_or_else script, "by library_search")] }

add_tactic_doc
{ name        := "library_search",
  category    := doc_category.hole_cmd,
  decl_names  := [`tactic.library_search_hole_cmd],
  tags        := ["search", "Try this"] }

end tactic


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.Mathport.Rename
import Std.Data.List.Basic
import Std.Data.List.Lemmas
import Mathlib.Init.Data.Nat.Notation
import Mathlib.Init.Data.Nat.Lemmas
import Mathlib.Init.Data.List.Basic
/-!
Lemmas for `List` not (yet) in `Std`
-/

open List Nat

namespace List

#align list.length_map₂ List.length_zipWith

#align list.ball_nil List.forall_mem_nil
#align list.ball_cons List.forall_mem_consₓ -- explicit → implicit arguments
#align list.mem_cons_iff List.mem_cons
#align list.sublist.cons2 List.Sublist.cons₂

section MapAccumr

variable {φ : Type w₁} {σ : Type w₂}

/-- Runs a function over a list returning the intermediate results and a
a final result.
-/
def mapAccumr (f : α → σ → σ × β) : List α → σ → σ × List β
  | [], c => (c, [])
  | y :: yr, c =>
    let r := mapAccumr f yr c
    let z := f y r.1
    (z.1, z.2 :: r.2)
#align list.map_accumr List.mapAccumr

/-- Length of the list obtained by `mapAccumr`. -/
@[simp]
theorem length_mapAccumr : ∀ (f : α → σ → σ × β) (x : List α) (s : σ),
    length (mapAccumr f x s).2 = length x
  | f, _ :: x, s => congrArg succ (length_mapAccumr f x s)
  | _, [], _ => rfl
#align list.length_map_accumr List.length_mapAccumr

end MapAccumr
section MapAccumr₂

variable {φ : Type w₁} {σ : Type w₂}

/-- Runs a function over two lists returning the intermediate results and a
 a final result.
-/
def mapAccumr₂ (f : α → β → σ → σ × φ) : List α → List β → σ → σ × List φ
  | [], _, c => (c, [])
  | _, [], c => (c, [])
  | x :: xr, y :: yr, c =>
    let r := mapAccumr₂ f xr yr c
    let q := f x y r.1
    (q.1, q.2 :: r.2)
#align list.map_accumr₂ List.mapAccumr₂

/-- Length of a list obtained using `mapAccumr₂`. -/
@[simp]
theorem length_mapAccumr₂ :
    ∀ (f : α → β → σ → σ × φ) (x y c), length (mapAccumr₂ f x y c).2 = min (length x) (length y)
  | f, _ :: x, _ :: y, c =>
    calc
      succ (length (mapAccumr₂ f x y c).2) = succ (min (length x) (length y)) :=
        congrArg succ (length_mapAccumr₂ f x y c)
      _ = min (succ (length x)) (succ (length y)) := Eq.symm (min_succ_succ (length x) (length y))

  | _, _ :: _, [], _ => rfl
  | _, [], _ :: _, _ => rfl
  | _, [], [], _ => rfl
#align list.length_map_accumr₂ List.length_mapAccumr₂

end MapAccumr₂

end List

#align list.length_zip_with List.length_zipWith
#align list.mem_replicate List.mem_replicate
#align list.eq_of_mem_replicate List.eq_of_mem_replicate


-- Infinite series of analytic functions

import analysis.analytic.basic
import data.complex.basic
import data.real.basic
import data.real.ennreal
import data.real.nnreal
import data.real.pi.bounds
import data.set.basic
import topology.metric_space.basic
import topology.uniform_space.uniform_convergence
import topology.algebra.infinite_sum

import analytic
import bounds
import simple
import tactics
import uniform

open complex (abs)
open filter (at_top)
open metric (ball closed_ball sphere)
open_locale real nnreal ennreal topological_space

noncomputable theory

-- Summability restricted to sets
def summable_on (f : ℕ → ℂ → ℂ) (s : set ℂ) := ∀ z, z ∈ s → summable (λ n, f n z)
def has_sum_on (f : ℕ → ℂ → ℂ) (g : ℂ → ℂ) (s : set ℂ) := ∀ z, z ∈ s → has_sum (λ n, f n z) (g z)
noncomputable def tsum_on (f : ℕ → ℂ → ℂ) := λ z, tsum (λ n, f n z)
def has_uniform_sum (f : ℕ → ℂ → ℂ) (g : ℂ → ℂ) (s : set ℂ) :=
  tendsto_uniformly_on (λ (N : finset ℕ) z, N.sum (λ n, f n z)) g at_top s

-- Uniform vanishing means late sums are uniformly small
def uniform_vanishing (f : ℕ → ℂ → ℂ) (s : set ℂ) :=
  ∀ e : ℝ, e > 0 → ∃ n : ℕ, ∀ (N : finset ℕ) z, late N n → z ∈ s → N.sum (λ n, abs (f n z)) < e

lemma uniform_vanishing_to_summable {f : ℕ → ℂ → ℂ} {s : set ℂ} {z : ℂ}
    (zs : z ∈ s) (h : uniform_vanishing f s) : summable (λ n, f n z) := begin
  rw [summable_iff_cauchy_seq_finset, metric.cauchy_seq_iff],
  intros e ep,
  rcases h e ep with ⟨m,hm⟩,
  existsi finset.range m,
  intros A HA B HB,
  calc dist (A.sum (λ n, f n z)) (B.sum (λ n, f n z)) ≤ (A ∆ B).sum (λ n, abs (f n z)) : symm_diff_bound _ _ _
  ... < e : hm (A ∆ B) z (symm_diff_late HA HB) zs
end

lemma uniform_vanishing_to_uniform_cauchy_series {f : ℕ → ℂ → ℂ} {s : set ℂ}
    (h : uniform_vanishing f s) : uniform_cauchy_seq_on (λ (N : finset ℕ) z, N.sum (λ n, f n z)) at_top s := begin
  rw metric.uniform_cauchy_seq_on_iff,
  intros e ep,
  rcases h e ep with ⟨m,hm⟩,
  existsi finset.range m,
  intros A HA B HB z zs,
  calc dist (A.sum (λ n, f n z)) (B.sum (λ n, f n z)) ≤ (A ∆ B).sum (λ n, abs (f n z)) : symm_diff_bound _ _ _
  ... < e : hm (A ∆ B) z (symm_diff_late HA HB) zs
end

lemma uniform_vanishing_to_tendsto_uniformly_on {f : ℕ → ℂ → ℂ} {s : set ℂ}
    (h : uniform_vanishing f s) : has_uniform_sum f (tsum_on f) s := begin
  rw [has_uniform_sum, metric.tendsto_uniformly_on_iff],
  intros e ep,
  rcases h (e/4) (by bound) with ⟨m,hm⟩,
  rw filter.eventually_at_top,
  existsi finset.range m,
  intros N Nm z zs,
  rw tsum_on, simp,
  generalize G : tsum (λ n, f n z) = g,
  have S : summable (λ n, f n z) := uniform_vanishing_to_summable zs h,
  have GS : has_sum (λ n, f n z) g, { rw ←G, exact summable.has_sum S }, clear S,
  rw has_sum at GS,
  rw metric.tendsto_at_top at GS,
  rcases GS (e/4) (by bound) with ⟨M,HM⟩, clear GS G h,
  set A := N ∪ (M \ N),
  have AM : M ⊆ A := simple.subset_union_sdiff _ _,
  simp at HM,
  specialize HM A AM,
  rw dist_comm at HM,
  calc dist g (N.sum (λ n, f n z)) ≤ dist g (A.sum (λ n, f n z)) + dist (A.sum (λ n, f n z)) (N.sum (λ n, f n z)) : by bound
  ... ≤ e/4 + dist (A.sum (λ n, f n z)) (N.sum (λ n, f n z)) : by bound
  ... = e/4 + dist (N.sum (λ n, f n z) + (M \ N).sum (λ n, f n z)) (N.sum (λ n, f n z))
      : by rw finset.sum_union finset.disjoint_sdiff
  ... = e/4 + abs (N.sum (λ n, f n z) + (M \ N).sum (λ n, f n z) - N.sum (λ n, f n z)) : by rw complex.dist_eq
  ... = e/4 + abs ((M \ N).sum (λ n, f n z)) : by ring_nf
  ... ≤ e/4 + (M \ N).sum (λ n, abs (f n z)) : by bound [simple.finset_complex_abs_sum_le (M \ N) (λ n, f n z)]
  ... ≤ e/4 + e/4 : by bound [hm (M \ N) z (sdiff_late M Nm) zs]
  ... = e/2 : by ring
  ... < e : by bound
end

-- Geometric bounds with c ≤ 0 are degenerate
lemma c_nonpos.degenerate {f : ℕ → ℂ → ℂ} {s : set ℂ} {c a : ℝ}
    (c0 : c ≤ 0) (a0 : 0 ≤ a) (hf : ∀ n z, z ∈ s → abs (f n z) ≤ c * a^n)
    : ∀ n z, z ∈ s → f n z = 0 := begin
  intros n z zs, specialize hf n z zs,
  have ca : c * a^n ≤ 0 := mul_nonpos_iff.mpr (or.inr ⟨c0, by bound⟩),
  exact complex.abs_eq_zero.mp (le_antisymm (trans hf ca) (complex.abs_nonneg _))
end

-- Uniformly exponentially converging series converge uniformly.
theorem fast_series_converge_uniformly_on {f : ℕ → ℂ → ℂ} {s : set ℂ} {c a : ℝ}
    (a0 : 0 ≤ a) (a1 : a < 1) (hf : ∀ n z, z ∈ s → abs (f n z) ≤ c * a^n)
    : has_uniform_sum f (tsum_on f) s := begin
  by_cases c0 : c ≤ 0, {
    have fz := c_nonpos.degenerate c0 a0 hf, simp at fz,
    rw [has_uniform_sum, metric.tendsto_uniformly_on_iff],
    intros e ep, apply filter.eventually_of_forall, intros n z zs,
    rw tsum_on, simp,
    simp_rw fz _ z zs, simp,
    assumption
  }, {
    simp at c0,
    apply uniform_vanishing_to_tendsto_uniformly_on,
    -- ∀ e : ℝ, e > 0 → ∃ n : ℕ, ∀ (N : finset ℕ) z, late N n → z ∈ s → N.sum (λ n, abs (f n z)) < e
    intros e ep,
    set t := (1-↑a)/↑c*(e/2),
    have tp : t > 0 := by bound,
    rcases exists_pow_lt_of_lt_one tp a1 with ⟨n,nt⟩,
    existsi n,
    intros N z NL zs,
    have a1p : 1 - (a : ℝ) > 0 := by bound,
    calc N.sum (λ n, abs (f n z)) ≤ N.sum (λ n, c * a^n) : finset.sum_le_sum (λ n _, hf n z zs)
    ... = c * N.sum (λ n, a^n) : finset.mul_sum.symm
    ... ≤ c * (a^n * (1 - a)⁻¹) : by bound [late_geometric_bound _ (by bound) a1]
    ... = a^n * (c * (1 - a)⁻¹) : by ring
    ... ≤ t * (c * (1 - a)⁻¹) : by bound
    ... = (1 - a) / c * (e / 2) * (c * (1 - a)⁻¹) : rfl
    ... = (1 - a) * (1 - a)⁻¹ * (c / c) * (e / 2) : by ring
    ... = 1 * 1 * (e / 2) : by rw [field.mul_inv_cancel (ne_of_gt a1p), simple.div_self (ne_of_gt c0)]
    ... = e / 2 : by ring
    ... < e : by bound
  }
end

-- Exponentially converging series converge.
theorem fast_series_converge_at {f : ℕ → ℂ} {c a : ℝ}
    (a0 : 0 ≤ a) (a1 : a < 1) (hf : ∀ n, abs (f n) ≤ c * a^n) : summable f := begin
  set s : set ℂ := {0},
  set g : ℕ → ℂ → ℂ := λ n _, f n,
  have hg : ∀ n z, z ∈ s → abs (g n z) ≤ c * a^n := λ n z zs, hf n,
  have u := fast_series_converge_uniformly_on a0 a1 hg,
  simp at u,
  rw has_uniform_sum at u,
  rw tendsto_uniformly_on_singleton_iff_tendsto at u,
  apply has_sum.summable, assumption
end

-- Finite sums of analytic functions are analytic
lemma finite_sums_are_analytic {f : ℕ → ℂ → ℂ} {s : set ℂ}
    (h : ∀ n, analytic_on ℂ (f n) s) (N : finset ℕ) : analytic_on ℂ (λ z, N.sum (λ n, f n z)) s := begin
  induction N using finset.induction with a B aB hB, {
    simp, intros z zs, exact entire.zero z
  }, {
    intros z zs,
    simp_rw finset.sum_insert aB,
    apply analytic_at.add,
    exact h a z zs,
    exact hB z zs
  }
end

-- Analytic series that converge exponentially converge to analytic functions.
theorem fast_series_converge {f : ℕ → ℂ → ℂ} {s : set ℂ} {c a : ℝ}
    (o : is_open s) (a0 : 0 ≤ a) (a1 : a < 1)
    (h : ∀ n, analytic_on ℂ (f n) s) (hf : ∀ n z, z ∈ s → abs (f n z) ≤ c * a^n)
    : ∃ (g : ℂ → ℂ), analytic_on ℂ g s ∧ has_sum_on f g s := begin
  set g := tsum_on f,
  existsi g,
  have su : has_uniform_sum f g s := fast_series_converge_uniformly_on a0 a1 hf,
  constructor, {
    refine uniform_analytic_lim o _ su,
    exact finite_sums_are_analytic h
  }, {
    intros z zs,
    exact summable.has_sum (fast_series_converge_at a0 a1 (λ n, hf n z zs))
  }
end


import category_theory.concrete_category.bundled_hom
import topology.category.Profinite
import logic.equiv.fin
--import for_mathlib.concrete
import for_mathlib.CompHaus
import for_mathlib.topology

import pseudo_normed_group.with_Tinv

/-!

# The category of profinitely filtered pseudo-normed groups.

The category of profinite pseudo-normed groups, and the category of
profinitely filtered pseudo-normed groups equipped with an action of T⁻¹.

-/
universe variables u

open category_theory
open_locale nnreal

local attribute [instance] type_pow

noncomputable theory

/-- The category of CompHaus-ly filtered pseudo-normed groups. -/
def CompHausFiltPseuNormGrp : Type (u+1) :=
bundled comphaus_filtered_pseudo_normed_group

namespace CompHausFiltPseuNormGrp

def bundled_hom : bundled_hom @comphaus_filtered_pseudo_normed_group_hom :=
⟨@comphaus_filtered_pseudo_normed_group_hom.to_fun,
 @comphaus_filtered_pseudo_normed_group_hom.id,
 @comphaus_filtered_pseudo_normed_group_hom.comp,
 @comphaus_filtered_pseudo_normed_group_hom.coe_inj⟩

local attribute [instance] bundled_hom
attribute [derive [large_category, concrete_category]] CompHausFiltPseuNormGrp

instance : has_coe_to_sort CompHausFiltPseuNormGrp Type* := bundled.has_coe_to_sort

instance (M : CompHausFiltPseuNormGrp) : comphaus_filtered_pseudo_normed_group M := M.str

/-- Construct a bundled `CompHausFiltPseuNormGrp` from the underlying type and typeclass. -/
def of (M : Type u) [comphaus_filtered_pseudo_normed_group M] : CompHausFiltPseuNormGrp :=
bundled.of M

@[simp]
lemma id_apply (M : CompHausFiltPseuNormGrp) (x : M) : (𝟙 M : M ⟶ M) x = x := rfl

end CompHausFiltPseuNormGrp


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

Finite maps over `multiset`.
-/
import data.list.alist data.finset data.pfun

universes u v w
open list
variables {α : Type u} {β : α → Type v}

namespace multiset

/-- Multiset of keys of an association multiset. -/
def keys (s : multiset (sigma β)) : multiset α :=
s.map sigma.fst

@[simp] theorem coe_keys {l : list (sigma β)} :
  keys (l : multiset (sigma β)) = (l.keys : multiset α) :=
rfl

/-- `nodupkeys s` means that `s` has no duplicate keys. -/
def nodupkeys (s : multiset (sigma β)) : Prop :=
quot.lift_on s list.nodupkeys (λ s t p, propext $ perm_nodupkeys p)

@[simp] theorem coe_nodupkeys {l : list (sigma β)} : @nodupkeys α β l ↔ l.nodupkeys := iff.rfl

end multiset

/-- `finmap β` is the type of finite maps over a multiset. It is effectively
  a quotient of `alist β` by permutation of the underlying list. -/
structure finmap (β : α → Type v) : Type (max u v) :=
(entries : multiset (sigma β))
(nodupkeys : entries.nodupkeys)

/-- The quotient map from `alist` to `finmap`. -/
def alist.to_finmap (s : alist β) : finmap β := ⟨s.entries, s.nodupkeys⟩

local notation `⟦`:max a `⟧`:0 := alist.to_finmap a

theorem alist.to_finmap_eq {s₁ s₂ : alist β} :
  ⟦s₁⟧ = ⟦s₂⟧ ↔ s₁.entries ~ s₂.entries :=
by cases s₁; cases s₂; simp [alist.to_finmap]

@[simp] theorem alist.to_finmap_entries (s : alist β) : ⟦s⟧.entries = s.entries := rfl

namespace finmap
open alist

/-- Lift a permutation-respecting function on `alist` to `finmap`. -/
@[elab_as_eliminator] def lift_on
  {γ} (s : finmap β) (f : alist β → γ)
  (H : ∀ a b : alist β, a.entries ~ b.entries → f a = f b) : γ :=
begin
  refine (quotient.lift_on s.1 (λ l, (⟨_, λ nd, f ⟨l, nd⟩⟩ : roption γ))
    (λ l₁ l₂ p, roption.ext' (perm_nodupkeys p) _) : roption γ).get _,
  { exact λ h₁ h₂, H _ _ (by exact p) },
  { have := s.nodupkeys, rcases s.entries with ⟨l⟩, exact id }
end

@[simp] theorem lift_on_to_finmap {γ} (s : alist β) (f : alist β → γ) (H) :
  lift_on ⟦s⟧ f H = f s := by cases s; refl

/-- Lift a permutation-respecting function on 2 `alist`s to 2 `finmap`s. -/
@[elab_as_eliminator] def lift_on₂
  {γ} (s₁ s₂ : finmap β) (f : alist β → alist β → γ)
  (H : ∀ a₁ b₁ a₂ b₂ : alist β, a₁.entries ~ a₂.entries → b₁.entries ~ b₂.entries → f a₁ b₁ = f a₂ b₂) : γ :=
lift_on s₁
  (λ l₁, lift_on s₂ (f l₁) (λ b₁ b₂ p, H _ _ _ _ (perm.refl _) p))
  (λ a₁ a₂ p, have H' : f a₁ = f a₂ := funext (λ _, H _ _ _ _ p (perm.refl _)), by simp only [H'])

@[simp] theorem lift_on₂_to_finmap {γ} (s₁ s₂ : alist β) (f : alist β → alist β → γ) (H) :
  lift_on₂ ⟦s₁⟧ ⟦s₂⟧ f H = f s₁ s₂ :=
by cases s₁; cases s₂; refl

@[elab_as_eliminator] theorem induction_on
  {C : finmap β → Prop} (s : finmap β) (H : ∀ (a : alist β), C ⟦a⟧) : C s :=
by rcases s with ⟨⟨a⟩, h⟩; exact H ⟨a, h⟩

@[elab_as_eliminator] theorem induction_on₂ {C : finmap β → finmap β → Prop}
  (s₁ s₂ : finmap β) (H : ∀ (a₁ a₂ : alist β), C ⟦a₁⟧ ⟦a₂⟧) : C s₁ s₂ :=
induction_on s₁ $ λ l₁, induction_on s₂ $ λ l₂, H l₁ l₂

@[elab_as_eliminator] theorem induction_on₃ {C : finmap β →  finmap β → finmap β → Prop}
  (s₁ s₂ s₃ : finmap β) (H : ∀ (a₁ a₂ a₃ : alist β), C ⟦a₁⟧ ⟦a₂⟧ ⟦a₃⟧) : C s₁ s₂ s₃ :=
induction_on₂ s₁ s₂ $ λ l₁ l₂, induction_on s₃ $ λ l₃, H l₁ l₂ l₃

@[extensionality] theorem ext : ∀ {s t : finmap β}, s.entries = t.entries → s = t
| ⟨l₁, h₁⟩ ⟨l₂, h₂⟩ H := by congr'

@[simp] theorem ext_iff {s t : finmap β} : s.entries = t.entries ↔ s = t :=
⟨ext, congr_arg _⟩

/-- The predicate `a ∈ s` means that `s` has a value associated to the key `a`. -/
instance : has_mem α (finmap β) := ⟨λ a s, a ∈ s.entries.keys⟩

theorem mem_def {a : α} {s : finmap β} :
  a ∈ s ↔ a ∈ s.entries.keys := iff.rfl

@[simp] theorem mem_to_finmap {a : α} {s : alist β} :
  a ∈ ⟦s⟧ ↔ a ∈ s := iff.rfl

/-- The set of keys of a finite map. -/
def keys (s : finmap β) : finset α :=
⟨s.entries.keys, induction_on s keys_nodup⟩

@[simp] theorem keys_val (s : alist β) : (keys ⟦s⟧).val = s.keys := rfl

@[simp] theorem keys_ext {s₁ s₂ : alist β} :
  keys ⟦s₁⟧ = keys ⟦s₂⟧ ↔ s₁.keys ~ s₂.keys :=
by simp [keys, alist.keys]

theorem mem_keys {a : α} {s : finmap β} : a ∈ s.keys ↔ a ∈ s :=
induction_on s $ λ s, alist.mem_keys

/-- The empty map. -/
instance : has_emptyc (finmap β) := ⟨⟨0, nodupkeys_nil⟩⟩

@[simp] theorem empty_to_finmap (s : alist β) :
  (⟦∅⟧ : finmap β) = ∅ := rfl

theorem not_mem_empty {a : α} : a ∉ (∅ : finmap β) :=
multiset.not_mem_zero a

@[simp] theorem keys_empty : (∅ : finmap β).keys = ∅ := rfl

/-- The singleton map. -/
def singleton (a : α) (b : β a) : finmap β :=
⟨⟨a, b⟩::0, nodupkeys_singleton _⟩

@[simp] theorem keys_singleton (a : α) (b : β a) :
  (singleton a b).keys = finset.singleton a := rfl

variables [decidable_eq α]

instance has_decidable_eq [∀ a, decidable_eq (β a)] : decidable_eq (finmap β)
| s₁ s₂ := decidable_of_iff _ ext_iff

/-- Look up the value associated to a key in a map. -/
def lookup (a : α) (s : finmap β) : option (β a) :=
lift_on s (lookup a) (λ s t, perm_lookup)

@[simp] theorem lookup_to_finmap (a : α) (s : alist β) :
  lookup a ⟦s⟧ = s.lookup a := rfl

@[simp] theorem lookup_empty (a) : lookup a (∅ : finmap β) = none :=
rfl

theorem lookup_is_some {a : α} {s : finmap β} :
  (s.lookup a).is_some ↔ a ∈ s :=
induction_on s $ λ s, alist.lookup_is_some

theorem lookup_eq_none {a} {s : finmap β} : lookup a s = none ↔ a ∉ s :=
induction_on s $ λ s, alist.lookup_eq_none

instance (a : α) (s : finmap β) : decidable (a ∈ s) :=
decidable_of_iff _ lookup_is_some

/-- Replace a key with a given value in a finite map.
  If the key is not present it does nothing. -/
def replace (a : α) (b : β a) (s : finmap β) : finmap β :=
lift_on s (λ t, ⟦replace a b t⟧) $
λ s₁ s₂ p, to_finmap_eq.2 $ perm_replace p

@[simp] theorem replace_to_finmap (a : α) (b : β a) (s : alist β) :
  replace a b ⟦s⟧ = ⟦s.replace a b⟧ := by simp [replace]

@[simp] theorem keys_replace (a : α) (b : β a) (s : finmap β) :
  (replace a b s).keys = s.keys :=
induction_on s $ λ s, by simp

@[simp] theorem mem_replace {a a' : α} {b : β a} {s : finmap β} :
  a' ∈ replace a b s ↔ a' ∈ s :=
induction_on s $ λ s, by simp

/-- Fold a commutative function over the key-value pairs in the map -/
def foldl {δ : Type w} (f : δ → Π a, β a → δ)
  (H : ∀ d a₁ b₁ a₂ b₂, f (f d a₁ b₁) a₂ b₂ = f (f d a₂ b₂) a₁ b₁)
  (d : δ) (m : finmap β) : δ :=
m.entries.foldl (λ d s, f d s.1 s.2) (λ d s t, H _ _ _ _ _) d

/-- Erase a key from the map. If the key is not present it does nothing. -/
def erase (a : α) (s : finmap β) : finmap β :=
lift_on s (λ t, ⟦erase a t⟧) $
λ s₁ s₂ p, to_finmap_eq.2 $ perm_erase p

@[simp] theorem erase_to_finmap (a : α) (s : alist β) :
  erase a ⟦s⟧ = ⟦s.erase a⟧ := by simp [erase]

@[simp]

@[simp] theorem keys_erase (a : α) (s : finmap β) :
  (erase a s).keys = s.keys.erase a :=
induction_on s $ λ s, by simp

@[simp] theorem mem_erase {a a' : α} {s : finmap β} : a' ∈ erase a s ↔ a' ≠ a ∧ a' ∈ s :=
induction_on s $ λ s, by simp

@[simp] theorem lookup_erase (a) (s : finmap β) : lookup a (erase a s) = none :=
induction_on s $ lookup_erase a

@[simp] theorem lookup_erase_ne {a a'} {s : finmap β} (h : a ≠ a') :
  lookup a (erase a' s) = lookup a s :=
induction_on s $ λ s, lookup_erase_ne h

/- insert -/

/-- Insert a key-value pair into a finite map, replacing any existing pair with
  the same key. -/
def insert (a : α) (b : β a) (s : finmap β) : finmap β :=
lift_on s (λ t, ⟦insert a b t⟧) $
λ s₁ s₂ p, to_finmap_eq.2 $ perm_insert p

@[simp] theorem insert_to_finmap (a : α) (b : β a) (s : alist β) :
  insert a b ⟦s⟧ = ⟦s.insert a b⟧ := by simp [insert]

theorem insert_entries_of_neg {a : α} {b : β a} {s : finmap β} : a ∉ s →
  (insert a b s).entries = ⟨a, b⟩ :: s.entries :=
induction_on s $ λ s h,
by simp [insert_entries_of_neg (mt mem_to_finmap.1 h)]

@[simp] theorem mem_insert {a a' : α} {b' : β a'} {s : finmap β} :
  a ∈ insert a' b' s ↔ a = a' ∨ a ∈ s :=
induction_on s mem_insert

@[simp] theorem lookup_insert {a} {b : β a} (s : finmap β) :
  lookup a (insert a b s) = some b :=
induction_on s $ λ s,
by simp only [insert_to_finmap, lookup_to_finmap, lookup_insert]

/- extract -/

/-- Erase a key from the map, and return the corresponding value, if found. -/
def extract (a : α) (s : finmap β) : option (β a) × finmap β :=
lift_on s (λ t, prod.map id to_finmap (extract a t)) $
λ s₁ s₂ p, by simp [perm_lookup p, to_finmap_eq, perm_erase p]

@[simp] theorem extract_eq_lookup_erase (a : α) (s : finmap β) :
  extract a s = (lookup a s, erase a s) :=
induction_on s $ λ s, by simp [extract]

/- union -/

/-- `s₁ ∪ s₂` is the key-based union of two finite maps. It is left-biased: if
there exists an `a ∈ s₁`, `lookup a (s₁ ∪ s₂) = lookup a s₁`. -/
def union (s₁ s₂ : finmap β) : finmap β :=
lift_on₂ s₁ s₂ (λ s₁ s₂, ⟦s₁ ∪ s₂⟧) $
λ s₁ s₂ s₃ s₄ p₁₃ p₂₄, to_finmap_eq.mpr $ perm_union p₁₃ p₂₄

instance : has_union (finmap β) := ⟨union⟩

@[simp] theorem mem_union {a} {s₁ s₂ : finmap β} :
  a ∈ s₁ ∪ s₂ ↔ a ∈ s₁ ∨ a ∈ s₂ :=
induction_on₂ s₁ s₂ $ λ _ _, mem_union

@[simp] theorem union_to_finmap (s₁ s₂ : alist β) : ⟦s₁⟧ ∪ ⟦s₂⟧ = ⟦s₁ ∪ s₂⟧ :=
by simp [(∪), union]

theorem keys_union {s₁ s₂ : finmap β} : (s₁ ∪ s₂).keys = s₁.keys ∪ s₂.keys :=
induction_on₂ s₁ s₂ $ λ s₁ s₂, finset.ext' $ by simp [keys]

@[simp] theorem lookup_union_left {a} {s₁ s₂ : finmap β} :
  a ∈ s₁ → lookup a (s₁ ∪ s₂) = lookup a s₁ :=
induction_on₂ s₁ s₂ $ λ s₁ s₂, lookup_union_left

@[simp] theorem lookup_union_right {a} {s₁ s₂ : finmap β} :
  a ∉ s₁ → lookup a (s₁ ∪ s₂) = lookup a s₂ :=
induction_on₂ s₁ s₂ $ λ s₁ s₂, lookup_union_right

@[simp] theorem mem_lookup_union {a} {b : β a} {s₁ s₂ : finmap β} :
  b ∈ lookup a (s₁ ∪ s₂) ↔ b ∈ lookup a s₁ ∨ a ∉ s₁ ∧ b ∈ lookup a s₂ :=
induction_on₂ s₁ s₂ $ λ s₁ s₂, mem_lookup_union

theorem mem_lookup_union_middle {a} {b : β a} {s₁ s₂ s₃ : finmap β} :
  b ∈ lookup a (s₁ ∪ s₃) → a ∉ s₂ → b ∈ lookup a (s₁ ∪ s₂ ∪ s₃) :=
induction_on₃ s₁ s₂ s₃ $ λ s₁ s₂ s₃, mem_lookup_union_middle

end finmap


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Joël Riou
-/
import algebra.homology.homotopy
import category_theory.abelian.homology

/-!
# Quasi-isomorphisms

A chain map is a quasi-isomorphism if it induces isomorphisms on homology.

## Future work

Define the derived category as the localization at quasi-isomorphisms?
-/

open category_theory
open category_theory.limits

universes v u

variables {ι : Type*}
variables {V : Type u} [category.{v} V] [has_zero_morphisms V] [has_zero_object V]
variables [has_equalizers V] [has_images V] [has_image_maps V] [has_cokernels V]
variables {c : complex_shape ι} {C D E : homological_complex V c}

/--
A chain map is a quasi-isomorphism if it induces isomorphisms on homology.
-/
class quasi_iso (f : C ⟶ D) : Prop :=
(is_iso : ∀ i, is_iso ((homology_functor V c i).map f))

attribute [instance] quasi_iso.is_iso

@[priority 100]
instance quasi_iso_of_iso (f : C ⟶ D) [is_iso f] : quasi_iso f :=
{ is_iso := λ i, begin
    change is_iso (((homology_functor V c i).map_iso (as_iso f)).hom),
    apply_instance,
  end }

instance quasi_iso_comp (f : C ⟶ D) [quasi_iso f] (g : D ⟶ E) [quasi_iso g] : quasi_iso (f ≫ g) :=
{ is_iso := λ i, begin
    rw functor.map_comp,
    apply_instance,
  end }

lemma quasi_iso_of_comp_left (f : C ⟶ D) [quasi_iso f] (g : D ⟶ E) [quasi_iso (f ≫ g)] :
  quasi_iso g :=
{ is_iso := λ i, is_iso.of_is_iso_fac_left ((homology_functor V c i).map_comp f g).symm }

lemma quasi_iso_of_comp_right (f : C ⟶ D) (g : D ⟶ E) [quasi_iso g] [quasi_iso (f ≫ g)] :
  quasi_iso f :=
{ is_iso := λ i, is_iso.of_is_iso_fac_right ((homology_functor V c i).map_comp f g).symm }

namespace homotopy_equiv

section
variables {W : Type*} [category W] [preadditive W] [has_cokernels W] [has_images W]
  [has_equalizers W] [has_zero_object W] [has_image_maps W]

/-- An homotopy equivalence is a quasi-isomorphism. -/
lemma to_quasi_iso {C D : homological_complex W c} (e : homotopy_equiv C D) :
  quasi_iso e.hom :=
⟨λ i, begin
  refine ⟨⟨(homology_functor W c i).map e.inv, _⟩⟩,
  simp only [← functor.map_comp, ← (homology_functor W c i).map_id],
  split; apply homology_map_eq_of_homotopy,
  exacts [e.homotopy_hom_inv_id, e.homotopy_inv_hom_id],
end⟩

lemma to_quasi_iso_inv {C D : homological_complex W c} (e : homotopy_equiv C D) (i : ι) :
  (@as_iso _ _ _ _ _ (e.to_quasi_iso.1 i)).inv = (homology_functor W c i).map e.inv :=
begin
  symmetry,
  simp only [←iso.hom_comp_eq_id, as_iso_hom, ←functor.map_comp, ←(homology_functor W c i).map_id,
    homology_map_eq_of_homotopy e.homotopy_hom_inv_id _],
end

end
end homotopy_equiv
namespace homological_complex.hom
section to_single₀
variables {W : Type*} [category W] [abelian W]

section
variables {X : chain_complex W ℕ} {Y : W} (f : X ⟶ ((chain_complex.single₀ _).obj Y))
  [hf : quasi_iso f]

/-- If a chain map `f : X ⟶ Y[0]` is a quasi-isomorphism, then the cokernel of the differential
`d : X₁ → X₀` is isomorphic to `Y.` -/
noncomputable def to_single₀_cokernel_at_zero_iso : cokernel (X.d 1 0) ≅ Y :=
(X.homology_zero_iso.symm.trans ((@as_iso _ _ _ _ _ (hf.1 0)).trans
  ((chain_complex.homology_functor_0_single₀ W).app Y)))

lemma to_single₀_cokernel_at_zero_iso_hom_eq [hf : quasi_iso f] :
  f.to_single₀_cokernel_at_zero_iso.hom = cokernel.desc (X.d 1 0) (f.f 0)
    (by rw ←f.2 1 0 rfl; exact comp_zero) :=
begin
  ext,
  dunfold to_single₀_cokernel_at_zero_iso chain_complex.homology_zero_iso homology_of_zero_right
    homology.map_iso chain_complex.homology_functor_0_single₀ cokernel.map,
  dsimp,
  simp only [cokernel.π_desc, category.assoc, homology.map_desc, cokernel.π_desc_assoc],
  simp [homology.desc, iso.refl_inv (X.X 0)],
end

lemma to_single₀_epi_at_zero [hf : quasi_iso f] :
  epi (f.f 0) :=
begin
  constructor,
  intros Z g h Hgh,
  rw [←cokernel.π_desc (X.d 1 0) (f.f 0) (by rw ←f.2 1 0 rfl; exact comp_zero),
    ←to_single₀_cokernel_at_zero_iso_hom_eq] at Hgh,
  rw (@cancel_epi _ _ _ _ _ _ (epi_comp _ _) _ _).1 Hgh,
end

lemma to_single₀_exact_d_f_at_zero [hf : quasi_iso f] :
  exact (X.d 1 0) (f.f 0) :=
begin
  rw preadditive.exact_iff_homology_zero,
  have h : X.d 1 0 ≫ f.f 0 = 0,
  { simp only [← f.2 1 0 rfl, chain_complex.single₀_obj_X_d, comp_zero], },
  refine ⟨h, nonempty.intro (homology_iso_kernel_desc _ _ _ ≪≫ _)⟩,
  { suffices : is_iso (cokernel.desc _ _ h),
    { haveI := this, apply kernel.of_mono, },
      rw ←to_single₀_cokernel_at_zero_iso_hom_eq,
      apply_instance }
end

lemma to_single₀_exact_at_succ [hf : quasi_iso f] (n : ℕ) :
  exact (X.d (n + 2) (n + 1)) (X.d (n + 1) n) :=
(preadditive.exact_iff_homology_zero _ _).2 ⟨X.d_comp_d _ _ _,
⟨(chain_complex.homology_succ_iso _ _).symm.trans
  ((@as_iso _ _ _ _ _ (hf.1 (n + 1))).trans homology_zero_zero)⟩⟩

end
section
variables {X : cochain_complex W ℕ} {Y : W}
  (f : (cochain_complex.single₀ _).obj Y ⟶ X)

/-- If a cochain map `f : Y[0] ⟶ X` is a quasi-isomorphism, then the kernel of the differential
`d : X₀ → X₁` is isomorphic to `Y.` -/
noncomputable def from_single₀_kernel_at_zero_iso [hf : quasi_iso f] : kernel (X.d 0 1) ≅ Y :=
(X.homology_zero_iso.symm.trans ((@as_iso _ _ _ _ _ (hf.1 0)).symm.trans
  ((cochain_complex.homology_functor_0_single₀ W).app Y)))

lemma from_single₀_kernel_at_zero_iso_inv_eq [hf : quasi_iso f] :
  f.from_single₀_kernel_at_zero_iso.inv = kernel.lift (X.d 0 1) (f.f 0)
    (by rw f.2 0 1 rfl; exact zero_comp) :=
begin
  ext,
  dunfold from_single₀_kernel_at_zero_iso cochain_complex.homology_zero_iso homology_of_zero_left
    homology.map_iso cochain_complex.homology_functor_0_single₀ kernel.map,
  simp only [iso.trans_inv, iso.app_inv, iso.symm_inv, category.assoc,
    equalizer_as_kernel, kernel.lift_ι],
  dsimp,
  simp only [category.assoc, homology.π_map, cokernel_zero_iso_target_hom,
    cokernel_iso_of_eq_hom_comp_desc, kernel_subobject_arrow, homology.π_map_assoc,
    is_iso.inv_comp_eq],
  simp [homology.π, kernel_subobject_map_comp, iso.refl_hom (X.X 0), category.comp_id],
end

lemma from_single₀_exact_f_d_at_zero [hf : quasi_iso f] :
  exact (f.f 0) (X.d 0 1) :=
begin
  rw preadditive.exact_iff_homology_zero,
  have h : f.f 0 ≫ X.d 0 1 = 0,
  { simp only [homological_complex.hom.comm, cochain_complex.single₀_obj_X_d, zero_comp] },
  refine ⟨h, nonempty.intro (homology_iso_cokernel_lift _ _ _ ≪≫ _)⟩,
  { suffices : is_iso (kernel.lift (X.d 0 1) (f.f 0) h),
    { haveI := this, apply cokernel.of_epi },
    rw ←from_single₀_kernel_at_zero_iso_inv_eq f,
    apply_instance },
end

lemma from_single₀_exact_at_succ [hf : quasi_iso f] (n : ℕ) :
  exact (X.d n (n + 1)) (X.d (n + 1) (n + 2)) :=
(preadditive.exact_iff_homology_zero _ _).2
  ⟨X.d_comp_d _ _ _, ⟨(cochain_complex.homology_succ_iso _ _).symm.trans
  ((@as_iso _ _ _ _ _ (hf.1 (n + 1))).symm.trans homology_zero_zero)⟩⟩

end
end to_single₀
end homological_complex.hom

variables {A : Type*} [category A] [abelian A] {B : Type*} [category B] [abelian B]
  (F : A ⥤ B) [functor.additive F] [preserves_finite_limits F] [preserves_finite_colimits F]
  [faithful F]

lemma category_theory.functor.quasi_iso_of_map_quasi_iso
  {C D : homological_complex A c} (f : C ⟶ D)
  (hf : quasi_iso ((F.map_homological_complex _).map f)) : quasi_iso f :=
⟨λ i, begin
  haveI : is_iso (F.map ((homology_functor A c i).map f)),
  { rw [← functor.comp_map, ← nat_iso.naturality_2 (F.homology_functor_iso i) f,
      functor.comp_map],
    apply_instance, },
  exact is_iso_of_reflects_iso _ F,
end⟩


/-
Copyright (c) 2022 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying
-/
import probability.martingale.borel_cantelli
import probability.conditional_expectation
import probability.independence

/-!

# The second Borel-Cantelli lemma

This file contains the second Borel-Cantelli lemma which states that, given a sequence of
independent sets `(sₙ)` in a probability space, if `∑ n, μ sₙ = ∞`, then the limsup of `sₙ` has
measure 1. We employ a proof using Lévy's generalized Borel-Cantelli by choosing an appropriate
filtration.

## Main result

- `probability_theory.measure_limsup_eq_one`: the second Borel-Cantelli lemma.

-/

open_locale measure_theory probability_theory ennreal big_operators topology

open measure_theory probability_theory measurable_space topological_space

namespace probability_theory

variables {Ω : Type*} {m0 : measurable_space Ω} {μ : measure Ω}
  [is_probability_measure μ]

section borel_cantelli

variables {ι β : Type*} [linear_order ι] [mβ : measurable_space β] [normed_add_comm_group β]
  [borel_space β] {f : ι → Ω → β} {i j : ι} {s : ι → set Ω}

lemma Indep_fun.indep_comap_natural_of_lt (hf : ∀ i, strongly_measurable (f i))
  (hfi : Indep_fun (λ i, mβ) f μ) (hij : i < j) :
  indep (measurable_space.comap (f j) mβ) (filtration.natural f hf i) μ :=
begin
  suffices : indep (⨆ k ∈ {j}, measurable_space.comap (f k) mβ)
    (⨆ k ∈ {k | k ≤ i}, measurable_space.comap (f k) mβ) μ,
  { rwa supr_singleton at this },
  exact indep_supr_of_disjoint (λ k, (hf k).measurable.comap_le) hfi (by simpa),
end

lemma Indep_fun.condexp_natrual_ae_eq_of_lt
  [second_countable_topology β] [complete_space β] [normed_space ℝ β]
  (hf : ∀ i, strongly_measurable (f i)) (hfi : Indep_fun (λ i, mβ) f μ) (hij : i < j) :
  μ[f j | filtration.natural f hf i] =ᵐ[μ] λ ω, μ[f j] :=
condexp_indep_eq (hf j).measurable.comap_le (filtration.le _ _)
  (comap_measurable $ f j).strongly_measurable
  (hfi.indep_comap_natural_of_lt hf hij)

lemma Indep_set.condexp_indicator_filtration_of_set_ae_eq
  (hsm : ∀ n, measurable_set (s n)) (hs : Indep_set s μ) (hij : i < j) :
  μ[(s j).indicator (λ ω, 1 : Ω → ℝ) | filtration_of_set hsm i] =ᵐ[μ] λ ω, (μ (s j)).to_real :=
begin
  rw filtration.filtration_of_set_eq_natural hsm,
  refine (Indep_fun.condexp_natrual_ae_eq_of_lt _ hs.Indep_fun_indicator hij).trans _,
  { simp only [integral_indicator_const _ (hsm _), algebra.id.smul_eq_mul, mul_one] },
  { apply_instance }
end

open filter

/-- **The second Borel-Cantelli lemma**: Given a sequence of independent sets `(sₙ)` such that
`∑ n, μ sₙ = ∞`, `limsup sₙ` has measure 1. -/
lemma measure_limsup_eq_one {s : ℕ → set Ω}
  (hsm : ∀ n, measurable_set (s n)) (hs : Indep_set s μ) (hs' : ∑' n, μ (s n) = ∞) :
  μ (limsup s at_top) = 1 :=
begin
  rw measure_congr (eventually_eq_set.2 (ae_mem_limsup_at_top_iff μ $
    measurable_set_filtration_of_set' hsm) :
      (limsup s at_top : set Ω) =ᵐ[μ] {ω | tendsto (λ n, ∑ k in finset.range n,
        μ[(s (k + 1)).indicator (1 : Ω → ℝ) | filtration_of_set hsm k] ω) at_top at_top}),
  suffices : {ω | tendsto (λ n, ∑ k in finset.range n,
    μ[(s (k + 1)).indicator (1 : Ω → ℝ) | filtration_of_set hsm k] ω) at_top at_top} =ᵐ[μ] set.univ,
  { rw [measure_congr this, measure_univ] },
  have : ∀ᵐ ω ∂μ, ∀ n, μ[(s (n + 1)).indicator (1 : Ω → ℝ) | filtration_of_set hsm n] ω = _ :=
    ae_all_iff.2 (λ n, hs.condexp_indicator_filtration_of_set_ae_eq hsm n.lt_succ_self),
  filter_upwards [this] with ω hω,
  refine eq_true_intro (_ : tendsto _ _ _),
  simp_rw hω,
  have htends : tendsto (λ n, ∑ k in finset.range n, μ (s (k + 1))) at_top (𝓝 ∞),
  { rw ← ennreal.tsum_add_one_eq_top hs' (measure_ne_top _ _),
    exact ennreal.tendsto_nat_tsum _ },
  rw ennreal.tendsto_nhds_top_iff_nnreal at htends,
  refine tendsto_at_top_at_top_of_monotone' _ _,
  { refine monotone_nat_of_le_succ (λ n, _),
    rw [← sub_nonneg, finset.sum_range_succ_sub_sum],
    exact ennreal.to_real_nonneg },
  { rintro ⟨B, hB⟩,
    refine not_eventually.2 (frequently_of_forall $ λ n, _) (htends B.to_nnreal),
    rw mem_upper_bounds at hB,
    specialize hB (∑ (k : ℕ) in finset.range n, μ (s (k + 1))).to_real _,
    { refine ⟨n, _⟩,
      rw ennreal.to_real_sum,
      exact λ _ _, measure_ne_top _ _ },
    { rw [not_lt, ← ennreal.to_real_le_to_real (ennreal.sum_lt_top _).ne ennreal.coe_ne_top],
      { exact hB.trans (by simp) },
      { exact λ _ _, measure_ne_top _ _ } } }
end

end borel_cantelli

end probability_theory


/-
Copyright (c) 2022 Thomas Browning. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning
-/
import analysis.complex.circle
import topology.continuous_function.algebra

/-!

# Continuous Monoid Homs

This file defines the space of continuous homomorphisms between two topological groups.

## Main definitions

* `continuous_monoid_hom A B`: The continuous homomorphisms `A →* B`.
* `continuous_add_monoid_hom A B`: The continuous additive homomorphisms `A →+ B`.
-/

open_locale pointwise

open function

variables (F A B C D E : Type*) [monoid A] [monoid B] [monoid C] [monoid D] [comm_group E]
  [topological_space A] [topological_space B] [topological_space C] [topological_space D]
  [topological_space E] [topological_group E]

/-- The type of continuous additive monoid homomorphisms from `A` to `B`.

When possible, instead of parametrizing results over `(f : continuous_add_monoid_hom A B)`,
you should parametrize over `(F : Type*) [continuous_add_monoid_hom_class F A B] (f : F)`.

When you extend this structure, make sure to extend `continuous_add_monoid_hom_class`. -/
structure continuous_add_monoid_hom (A B : Type*) [add_monoid A] [add_monoid B]
  [topological_space A] [topological_space B] extends A →+ B :=
(continuous_to_fun : continuous to_fun)

/-- The type of continuous monoid homomorphisms from `A` to `B`.

When possible, instead of parametrizing results over `(f : continuous_monoid_hom A B)`,
you should parametrize over `(F : Type*) [continuous_monoid_hom_class F A B] (f : F)`.

When you extend this structure, make sure to extend `continuous_add_monoid_hom_class`. -/
@[to_additive]
structure continuous_monoid_hom extends A →* B :=
(continuous_to_fun : continuous to_fun)

section
set_option old_structure_cmd true

/-- `continuous_add_monoid_hom_class F A B` states that `F` is a type of continuous additive monoid
homomorphisms.

You should also extend this typeclass when you extend `continuous_add_monoid_hom`. -/
class continuous_add_monoid_hom_class (A B : Type*) [add_monoid A] [add_monoid B]
  [topological_space A] [topological_space B] extends add_monoid_hom_class F A B :=
(map_continuous (f : F) : continuous f)

/-- `continuous_monoid_hom_class F A B` states that `F` is a type of continuous additive monoid
homomorphisms.

You should also extend this typeclass when you extend `continuous_monoid_hom`. -/
@[to_additive]
class continuous_monoid_hom_class extends monoid_hom_class F A B :=
(map_continuous (f : F) : continuous f)

attribute [to_additive continuous_add_monoid_hom_class.to_add_monoid_hom_class]
  continuous_monoid_hom_class.to_monoid_hom_class

end

/-- Reinterpret a `continuous_monoid_hom` as a `monoid_hom`. -/
add_decl_doc continuous_monoid_hom.to_monoid_hom

/-- Reinterpret a `continuous_add_monoid_hom` as an `add_monoid_hom`. -/
add_decl_doc continuous_add_monoid_hom.to_add_monoid_hom

@[priority 100, to_additive] -- See note [lower instance priority]
instance continuous_monoid_hom_class.to_continuous_map_class [continuous_monoid_hom_class F A B] :
  continuous_map_class F A B :=
{ .. ‹continuous_monoid_hom_class F A B› }

namespace continuous_monoid_hom
variables {A B C D E}

@[to_additive]
instance : continuous_monoid_hom_class (continuous_monoid_hom A B) A B :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by { obtain ⟨⟨_, _⟩, _⟩ := f, obtain ⟨⟨_, _⟩, _⟩ := g, congr' },
  map_mul := λ f, f.map_mul',
  map_one := λ f, f.map_one',
  map_continuous := λ f, f.continuous_to_fun }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
@[to_additive "Helper instance for when there's too many metavariables to apply
`fun_like.has_coe_to_fun` directly."]
instance : has_coe_to_fun (continuous_monoid_hom A B) (λ _, A → B) := fun_like.has_coe_to_fun

@[to_additive, ext] lemma ext {f g : continuous_monoid_hom A B} (h : ∀ x, f x = g x) : f = g :=
fun_like.ext _ _ h

/-- Reinterpret a `continuous_monoid_hom` as a `continuous_map`. -/
@[to_additive "Reinterpret a `continuous_add_monoid_hom` as a `continuous_map`."]
def to_continuous_map (f : continuous_monoid_hom A B) : C(A, B) := { .. f}

@[to_additive] lemma to_continuous_map_injective : injective (to_continuous_map : _ → C(A, B)) :=
λ f g h, ext $ by convert fun_like.ext_iff.1 h

/-- Construct a `continuous_monoid_hom` from a `continuous` `monoid_hom`. -/
@[to_additive "Construct a `continuous_add_monoid_hom` from a `continuous` `add_monoid_hom`.",
  simps]
def mk' (f : A →* B) (hf : continuous f) : continuous_monoid_hom A B :=
{ continuous_to_fun := hf, .. f }

/-- Composition of two continuous homomorphisms. -/
@[to_additive "Composition of two continuous homomorphisms.", simps]
def comp (g : continuous_monoid_hom B C) (f : continuous_monoid_hom A B) :
  continuous_monoid_hom A C :=
mk' (g.to_monoid_hom.comp f.to_monoid_hom) (g.continuous_to_fun.comp f.continuous_to_fun)

/-- Product of two continuous homomorphisms on the same space. -/
@[to_additive "Product of two continuous homomorphisms on the same space.", simps]
def prod (f : continuous_monoid_hom A B) (g : continuous_monoid_hom A C) :
  continuous_monoid_hom A (B × C) :=
mk' (f.to_monoid_hom.prod g.to_monoid_hom) (f.continuous_to_fun.prod_mk g.continuous_to_fun)

/-- Product of two continuous homomorphisms on different spaces. -/
@[to_additive "Product of two continuous homomorphisms on different spaces.", simps]
def prod_map (f : continuous_monoid_hom A C) (g : continuous_monoid_hom B D) :
  continuous_monoid_hom (A × B) (C × D) :=
mk' (f.to_monoid_hom.prod_map g.to_monoid_hom) (f.continuous_to_fun.prod_map g.continuous_to_fun)

variables (A B C D E)

/-- The trivial continuous homomorphism. -/
@[to_additive "The trivial continuous homomorphism.", simps]
def one : continuous_monoid_hom A B := mk' 1 continuous_const

@[to_additive] instance : inhabited (continuous_monoid_hom A B) := ⟨one A B⟩

/-- The identity continuous homomorphism. -/
@[to_additive "The identity continuous homomorphism.", simps]
def id : continuous_monoid_hom A A := mk' (monoid_hom.id A) continuous_id

/-- The continuous homomorphism given by projection onto the first factor. -/
@[to_additive "The continuous homomorphism given by projection onto the first factor.", simps]
def fst : continuous_monoid_hom (A × B) A := mk' (monoid_hom.fst A B) continuous_fst

/-- The continuous homomorphism given by projection onto the second factor. -/
@[to_additive "The continuous homomorphism given by projection onto the second factor.", simps]
def snd : continuous_monoid_hom (A × B) B := mk' (monoid_hom.snd A B) continuous_snd

/-- The continuous homomorphism given by inclusion of the first factor. -/
@[to_additive "The continuous homomorphism given by inclusion of the first factor.", simps]
def inl : continuous_monoid_hom A (A × B) := prod (id A) (one A B)

/-- The continuous homomorphism given by inclusion of the second factor. -/
@[to_additive "The continuous homomorphism given by inclusion of the second factor.", simps]
def inr : continuous_monoid_hom B (A × B) := prod (one B A) (id B)

/-- The continuous homomorphism given by the diagonal embedding. -/
@[to_additive "The continuous homomorphism given by the diagonal embedding.", simps]
def diag : continuous_monoid_hom A (A × A) := prod (id A) (id A)

/-- The continuous homomorphism given by swapping components. -/
@[to_additive "The continuous homomorphism given by swapping components.", simps]
def swap : continuous_monoid_hom (A × B) (B × A) := prod (snd A B) (fst A B)

/-- The continuous homomorphism given by multiplication. -/
@[to_additive "The continuous homomorphism given by addition.", simps]
def mul : continuous_monoid_hom (E × E) E :=
mk' mul_monoid_hom continuous_mul

/-- The continuous homomorphism given by inversion. -/
@[to_additive "The continuous homomorphism given by negation.", simps]
def inv : continuous_monoid_hom E E :=
mk' inv_monoid_hom continuous_inv

variables {A B C D E}

/-- Coproduct of two continuous homomorphisms to the same space. -/
@[to_additive "Coproduct of two continuous homomorphisms to the same space.", simps]
def coprod (f : continuous_monoid_hom A E) (g : continuous_monoid_hom B E) :
  continuous_monoid_hom (A × B) E :=
(mul E).comp (f.prod_map g)

@[to_additive] instance : comm_group (continuous_monoid_hom A E) :=
{ mul := λ f g, (mul E).comp (f.prod g),
  mul_comm := λ f g, ext (λ x, mul_comm (f x) (g x)),
  mul_assoc := λ f g h, ext (λ x, mul_assoc (f x) (g x) (h x)),
  one := one A E,
  one_mul := λ f, ext (λ x, one_mul (f x)),
  mul_one := λ f, ext (λ x, mul_one (f x)),
  inv := λ f, (inv E).comp f,
  mul_left_inv := λ f, ext (λ x, mul_left_inv (f x)) }

@[to_additive] instance : topological_space (continuous_monoid_hom A B) :=
topological_space.induced to_continuous_map continuous_map.compact_open

variables (A B C D E)

@[to_additive] lemma inducing_to_continuous_map :
  inducing (to_continuous_map : continuous_monoid_hom A B → C(A, B)) := ⟨rfl⟩

@[to_additive] lemma embedding_to_continuous_map :
  embedding (to_continuous_map : continuous_monoid_hom A B → C(A, B)) :=
⟨inducing_to_continuous_map A B, to_continuous_map_injective⟩

@[to_additive] lemma closed_embedding_to_continuous_map [has_continuous_mul B] [t2_space B] :
  closed_embedding (to_continuous_map : continuous_monoid_hom A B → C(A, B)) :=
⟨embedding_to_continuous_map A B, ⟨begin
  suffices : (set.range (to_continuous_map : continuous_monoid_hom A B → C(A, B))) =
    ({f | f '' {1} ⊆ {1}ᶜ} ∪ ⋃ (x y) (U V W) (hU : is_open U) (hV : is_open V) (hW : is_open W)
    (h : disjoint (U * V) W), {f | f '' {x} ⊆ U} ∩ {f | f '' {y} ⊆ V} ∩ {f | f '' {x * y} ⊆ W})ᶜ,
  { rw [this, compl_compl],
    refine (continuous_map.is_open_gen is_compact_singleton is_open_compl_singleton).union _,
    repeat { apply is_open_Union, intro, },
    repeat { apply is_open.inter },
    all_goals { apply continuous_map.is_open_gen is_compact_singleton, assumption } },
  simp_rw [set.compl_union, set.compl_Union, set.image_singleton, set.singleton_subset_iff,
    set.ext_iff, set.mem_inter_iff, set.mem_Inter, set.mem_compl_iff],
  refine λ f, ⟨_, _⟩,
  { rintros ⟨f, rfl⟩,
    exact ⟨λ h, h (map_one f), λ x y U V W hU hV hW h ⟨⟨hfU, hfV⟩, hfW⟩,
      h.le_bot ⟨set.mul_mem_mul hfU hfV, (congr_arg (∈ W) (map_mul f x y)).mp hfW⟩⟩ },
  { rintros ⟨hf1, hf2⟩,
    suffices : ∀ x y, f (x * y) = f x * f y,
    { refine ⟨({ map_one' := of_not_not hf1, map_mul' := this, .. f } : continuous_monoid_hom A B),
       continuous_map.ext (λ _, rfl)⟩, },
    intros x y,
    contrapose! hf2,
    obtain ⟨UV, W, hUV, hW, hfUV, hfW, h⟩ := t2_separation hf2.symm,
    have hB := @continuous_mul B _ _ _,
    obtain ⟨U, V, hU, hV, hfU, hfV, h'⟩ := is_open_prod_iff.mp (hUV.preimage hB) (f x) (f y) hfUV,
    refine ⟨x, y, U, V, W, hU, hV, hW, h.mono_left _, ⟨hfU, hfV⟩, hfW⟩,
    rintros _ ⟨x, y, hx : (x, y).1 ∈ U, hy : (x, y).2 ∈ V, rfl⟩,
    exact h' ⟨hx, hy⟩ },
end⟩⟩

variables {A B C D E}

@[to_additive] instance [t2_space B] : t2_space (continuous_monoid_hom A B) :=
(embedding_to_continuous_map A B).t2_space

@[to_additive] instance : topological_group (continuous_monoid_hom A E) :=
let hi := inducing_to_continuous_map A E, hc := hi.continuous in
{ continuous_mul := hi.continuous_iff.mpr (continuous_mul.comp (continuous.prod_map hc hc)),
  continuous_inv := hi.continuous_iff.mpr (continuous_inv.comp hc) }

@[to_additive] lemma continuous_of_continuous_uncurry {A : Type*} [topological_space A]
  (f : A → continuous_monoid_hom B C) (h : continuous (function.uncurry (λ x y, f x y))) :
  continuous f :=
(inducing_to_continuous_map _ _).continuous_iff.mpr
  (continuous_map.continuous_of_continuous_uncurry _ h)

@[to_additive] lemma continuous_comp [locally_compact_space B] :
  continuous (λ f : continuous_monoid_hom A B × continuous_monoid_hom B C, f.2.comp f.1) :=
(inducing_to_continuous_map A C).continuous_iff.2 $ (continuous_map.continuous_comp'.comp
    ((inducing_to_continuous_map A B).prod_mk (inducing_to_continuous_map B C)).continuous)

@[to_additive] lemma continuous_comp_left (f : continuous_monoid_hom A B) :
  continuous (λ g : continuous_monoid_hom B C, g.comp f) :=
(inducing_to_continuous_map A C).continuous_iff.2 $ f.to_continuous_map.continuous_comp_left.comp
  (inducing_to_continuous_map B C).continuous

@[to_additive] lemma continuous_comp_right (f : continuous_monoid_hom B C) :
  continuous (λ g : continuous_monoid_hom A B, f.comp g) :=
(inducing_to_continuous_map A C).continuous_iff.2 $ f.to_continuous_map.continuous_comp.comp
  (inducing_to_continuous_map A B).continuous

variables (E)

/-- `continuous_monoid_hom _ f` is a functor. -/
@[to_additive "`continuous_add_monoid_hom _ f` is a functor."]
def comp_left (f : continuous_monoid_hom A B) :
  continuous_monoid_hom (continuous_monoid_hom B E) (continuous_monoid_hom A E) :=
{ to_fun := λ g, g.comp f,
  map_one' := rfl,
  map_mul' := λ g h, rfl,
  continuous_to_fun := f.continuous_comp_left }

variables (A) {E}

/-- `continuous_monoid_hom f _` is a functor. -/
@[to_additive "`continuous_add_monoid_hom f _` is a functor."]
def comp_right {B : Type*} [comm_group B] [topological_space B]
  [topological_group B] (f : continuous_monoid_hom B E) :
  continuous_monoid_hom (continuous_monoid_hom A B) (continuous_monoid_hom A E) :=
{ to_fun := λ g, f.comp g,
  map_one' := ext (λ a, map_one f),
  map_mul' := λ g h, ext (λ a, map_mul f (g a) (h a)),
  continuous_to_fun := f.continuous_comp_right }

end continuous_monoid_hom

/-- The Pontryagin dual of `A` is the group of continuous homomorphism `A → circle`. -/
@[derive [topological_space, t2_space, comm_group, topological_group, inhabited]]
def pontryagin_dual := continuous_monoid_hom A circle

variables {A B C D E}

namespace pontryagin_dual

open continuous_monoid_hom

noncomputable instance : continuous_monoid_hom_class (pontryagin_dual A) A circle :=
continuous_monoid_hom.continuous_monoid_hom_class

/-- `pontryagin_dual` is a functor. -/
noncomputable def map (f : continuous_monoid_hom A B) :
  continuous_monoid_hom (pontryagin_dual B) (pontryagin_dual A) :=
f.comp_left circle

@[simp] lemma map_apply (f : continuous_monoid_hom A B) (x : pontryagin_dual B) (y : A) :
  map f x y = x (f y) :=
rfl

@[simp] lemma map_one : map (one A B) = one (pontryagin_dual B) (pontryagin_dual A) :=
ext (λ x, ext (λ y, map_one x))

@[simp] lemma map_comp (g : continuous_monoid_hom B C) (f : continuous_monoid_hom A B) :
  map (comp g f) = comp (map f) (map g) :=
ext (λ x, ext (λ y, rfl))

@[simp] lemma map_mul (f g : continuous_monoid_hom A E) : map (f * g) = map f * map g :=
ext (λ x, ext (λ y, map_mul x (f y) (g y)))

variables (A B C D E)

/-- `continuous_monoid_hom.dual` as a `continuous_monoid_hom`. -/
noncomputable def map_hom [locally_compact_space E] :
  continuous_monoid_hom (continuous_monoid_hom A E)
    (continuous_monoid_hom (pontryagin_dual E) (pontryagin_dual A)) :=
{ to_fun := map,
  map_one' := map_one,
  map_mul' := map_mul,
  continuous_to_fun := continuous_of_continuous_uncurry _ continuous_comp }

end pontryagin_dual