/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

! This file was ported from Lean 3 source module data.finset.pi
! leanprover-community/mathlib commit 4c586d291f189eecb9d00581aeb3dd998ac34442
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Finset.Image
import Mathbin.Data.Multiset.Pi

/-!
# The cartesian product of finsets

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

namespace Finset

open Multiset

/-! ### pi -/

section Pi

variable {α : Type _}

#print Finset.Pi.empty /-
/-- The empty dependent product function, defined on the empty set. The assumption `a ∈ ∅` is never
satisfied. -/
def Pi.empty (β : α → Sort _) (a : α) (h : a ∈ (∅ : Finset α)) : β a :=
  Multiset.Pi.empty β a h
#align finset.pi.empty Finset.Pi.empty
-/

variable {β : α → Type _} {δ : α → Sort _} [DecidableEq α]

/- warning: finset.pi -> Finset.pi is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] (s : Finset.{u1} α), (forall (a : α), Finset.{u2} (β a)) -> (Finset.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (β a)))
but is expected to have type
  forall {α : Type.{u2}} {β : α -> Type.{u1}} [_inst_1 : DecidableEq.{succ u2} α] (s : Finset.{u2} α), (forall (a : α), Finset.{u1} (β a)) -> (Finset.{max u1 u2} (forall (a : α), (Membership.mem.{u2, u2} α (Finset.{u2} α) (Finset.instMembershipFinset.{u2} α) a s) -> (β a)))
Case conversion may be inaccurate. Consider using '#align finset.pi Finset.piₓ'. -/
/-- Given a finset `s` of `α` and for all `a : α` a finset `t a` of `δ a`, then one can define the
finset `s.pi t` of all functions defined on elements of `s` taking values in `t a` for `a ∈ s`.
Note that the elements of `s.pi t` are only partially defined, on `s`. -/
def pi (s : Finset α) (t : ∀ a, Finset (β a)) : Finset (∀ a ∈ s, β a) :=
  ⟨s.1.pi fun a => (t a).1, s.Nodup.pi fun a _ => (t a).Nodup⟩
#align finset.pi Finset.pi

/- warning: finset.pi_val -> Finset.pi_val is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] (s : Finset.{u1} α) (t : forall (a : α), Finset.{u2} (β a)), Eq.{succ (max u1 u2)} (Multiset.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (β a))) (Finset.val.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (β a)) (Finset.pi.{u1, u2} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) s t)) (Multiset.pi.{u1, u2} α (fun (a : α) (b : α) => _inst_1 a b) (fun (a : α) => β a) (Finset.val.{u1} α s) (fun (a : α) => Finset.val.{u2} (β a) (t a)))
but is expected to have type
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] (s : Finset.{u1} α) (t : forall (a : α), Finset.{u2} (β a)), Eq.{max (succ u2) (succ u1)} (Multiset.{max u2 u1} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (β a))) (Finset.val.{max u2 u1} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (β a)) (Finset.pi.{u2, u1} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) s t)) (Multiset.pi.{u2, u1} α (fun (a : α) (b : α) => _inst_1 a b) (fun (a : α) => β a) (Finset.val.{u1} α s) (fun (a : α) => Finset.val.{u2} (β a) (t a)))
Case conversion may be inaccurate. Consider using '#align finset.pi_val Finset.pi_valₓ'. -/
@[simp]
theorem pi_val (s : Finset α) (t : ∀ a, Finset (β a)) : (s.pi t).1 = s.1.pi fun a => (t a).1 :=
  rfl
#align finset.pi_val Finset.pi_val

/- warning: finset.mem_pi -> Finset.mem_pi is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {s : Finset.{u1} α} {t : forall (a : α), Finset.{u2} (β a)} {f : forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (β a)}, Iff (Membership.Mem.{max u1 u2, max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (β a)) (Finset.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (β a))) (Finset.hasMem.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (β a))) f (Finset.pi.{u1, u2} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) s t)) (forall (a : α) (h : Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s), Membership.Mem.{u2, u2} (β a) (Finset.{u2} (β a)) (Finset.hasMem.{u2} (β a)) (f a h) (t a))
but is expected to have type
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {s : Finset.{u1} α} {t : forall (a : α), Finset.{u2} (β a)} {f : forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (β a)}, Iff (Membership.mem.{max u2 u1, max u1 u2} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (β a)) (Finset.{max u2 u1} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (β a))) (Finset.instMembershipFinset.{max u2 u1} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (β a))) f (Finset.pi.{u2, u1} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) s t)) (forall (a : α) (h : Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s), Membership.mem.{u2, u2} (β a) (Finset.{u2} (β a)) (Finset.instMembershipFinset.{u2} (β a)) (f a h) (t a))
Case conversion may be inaccurate. Consider using '#align finset.mem_pi Finset.mem_piₓ'. -/
@[simp]
theorem mem_pi {s : Finset α} {t : ∀ a, Finset (β a)} {f : ∀ a ∈ s, β a} :
    f ∈ s.pi t ↔ ∀ (a) (h : a ∈ s), f a h ∈ t a :=
  mem_pi _ _ _
#align finset.mem_pi Finset.mem_pi

/- warning: finset.pi.cons -> Finset.Pi.cons is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {δ : α -> Sort.{u2}} [_inst_1 : DecidableEq.{succ u1} α] (s : Finset.{u1} α) (a : α), (δ a) -> (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (δ a)) -> (forall (a' : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a' (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.hasInsert.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (δ a'))
but is expected to have type
  forall {α : Type.{u2}} {δ : α -> Sort.{u1}} [_inst_1 : DecidableEq.{succ u2} α] (s : Finset.{u2} α) (a : α), (δ a) -> (forall (a : α), (Membership.mem.{u2, u2} α (Finset.{u2} α) (Finset.instMembershipFinset.{u2} α) a s) -> (δ a)) -> (forall (a' : α), (Membership.mem.{u2, u2} α (Finset.{u2} α) (Finset.instMembershipFinset.{u2} α) a' (Insert.insert.{u2, u2} α (Finset.{u2} α) (Finset.instInsertFinset.{u2} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (δ a'))
Case conversion may be inaccurate. Consider using '#align finset.pi.cons Finset.Pi.consₓ'. -/
/-- Given a function `f` defined on a finset `s`, define a new function on the finset `s ∪ {a}`,
equal to `f` on `s` and sending `a` to a given value `b`. This function is denoted
`s.pi.cons a b f`. If `a` already belongs to `s`, the new function takes the value `b` at `a`
anyway. -/
def Pi.cons (s : Finset α) (a : α) (b : δ a) (f : ∀ a, a ∈ s → δ a) (a' : α) (h : a' ∈ insert a s) :
    δ a' :=
  Multiset.Pi.cons s.1 a b f _ (Multiset.mem_cons.2 <| mem_insert.symm.2 h)
#align finset.pi.cons Finset.Pi.cons

/- warning: finset.pi.cons_same -> Finset.Pi.cons_same is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {δ : α -> Sort.{u2}} [_inst_1 : DecidableEq.{succ u1} α] (s : Finset.{u1} α) (a : α) (b : δ a) (f : forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (δ a)) (h : Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.hasInsert.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)), Eq.{u2} (δ a) (Finset.Pi.cons.{u1, u2} α (fun (a : α) => δ a) (fun (a : α) (b : α) => _inst_1 a b) s a b f a h) b
but is expected to have type
  forall {α : Type.{u1}} {δ : α -> Sort.{u2}} [_inst_1 : DecidableEq.{succ u1} α] (s : Finset.{u1} α) (a : α) (b : δ a) (f : forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (δ a)) (h : Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.instInsertFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)), Eq.{u2} (δ a) (Finset.Pi.cons.{u2, u1} α δ (fun (a : α) (b : α) => _inst_1 a b) s a b f a h) b
Case conversion may be inaccurate. Consider using '#align finset.pi.cons_same Finset.Pi.cons_sameₓ'. -/
@[simp]
theorem Pi.cons_same (s : Finset α) (a : α) (b : δ a) (f : ∀ a, a ∈ s → δ a) (h : a ∈ insert a s) :
    Pi.cons s a b f a h = b :=
  Multiset.Pi.cons_same _
#align finset.pi.cons_same Finset.Pi.cons_same

/- warning: finset.pi.cons_ne -> Finset.Pi.cons_ne is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {δ : α -> Sort.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {s : Finset.{u1} α} {a : α} {a' : α} {b : δ a} {f : forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (δ a)} {h : Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a' (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.hasInsert.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)} (ha : Ne.{succ u1} α a a'), Eq.{u2} (δ a') (Finset.Pi.cons.{u1, u2} α (fun {a : α} => δ a) (fun (a : α) (b : α) => _inst_1 a b) s a b f a' h) (f a' (Or.resolve_left (Eq.{succ u1} α a' a) (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a' s) (Iff.mp (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a' (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.hasInsert.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) (Or (Eq.{succ u1} α a' a) (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a' s)) (Finset.mem_insert.{u1} α (fun (a : α) (b : α) => _inst_1 a b) s a' a) h) (Ne.symm.{succ u1} α a a' ha)))
but is expected to have type
  forall {α : Type.{u1}} {δ : α -> Sort.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {s : Finset.{u1} α} {a : α} {a' : α} {b : δ a} {f : forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (δ a)} {h : Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a' (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.instInsertFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)} (ha : Ne.{succ u1} α a a'), Eq.{u2} (δ a') (Finset.Pi.cons.{u2, u1} α δ (fun (a : α) (b : α) => _inst_1 a b) s a b f a' h) (f a' (Or.resolve_left (Eq.{succ u1} α a' a) (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a' s) (Iff.mp (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a' (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.instInsertFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) (Or (Eq.{succ u1} α a' a) (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a' s)) (Finset.mem_insert.{u1} α (fun (a : α) (b : α) => _inst_1 a b) s a' a) h) (Ne.symm.{succ u1} α a a' ha)))
Case conversion may be inaccurate. Consider using '#align finset.pi.cons_ne Finset.Pi.cons_neₓ'. -/
theorem Pi.cons_ne {s : Finset α} {a a' : α} {b : δ a} {f : ∀ a, a ∈ s → δ a} {h : a' ∈ insert a s}
    (ha : a ≠ a') : Pi.cons s a b f a' h = f a' ((mem_insert.1 h).resolve_left ha.symm) :=
  Multiset.Pi.cons_ne _ _
#align finset.pi.cons_ne Finset.Pi.cons_ne

/- warning: finset.pi_cons_injective -> Finset.pi_cons_injective is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {δ : α -> Sort.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {a : α} {b : δ a} {s : Finset.{u1} α}, (Not (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s)) -> (Function.Injective.{imax (succ u1) u2, imax (succ u1) u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (δ a)) (forall (a' : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a' (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.hasInsert.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (δ a')) (Finset.Pi.cons.{u1, u2} α (fun {a : α} => δ a) (fun (a : α) (b : α) => _inst_1 a b) s a b))
but is expected to have type
  forall {α : Type.{u1}} {δ : α -> Sort.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {a : α} {b : δ a} {s : Finset.{u1} α}, (Not (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s)) -> (Function.Injective.{imax (succ u1) u2, imax (succ u1) u2} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (δ a)) (forall (a' : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a' (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.instInsertFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (δ a')) (Finset.Pi.cons.{u2, u1} α δ (fun (a : α) (b : α) => _inst_1 a b) s a b))
Case conversion may be inaccurate. Consider using '#align finset.pi_cons_injective Finset.pi_cons_injectiveₓ'. -/
theorem pi_cons_injective {a : α} {b : δ a} {s : Finset α} (hs : a ∉ s) :
    Function.Injective (Pi.cons s a b) := fun e₁ e₂ eq =>
  @Multiset.pi_cons_injective α _ δ a b s.1 hs _ _ <|
    funext fun e =>
      funext fun h =>
        have :
          Pi.cons s a b e₁ e (by simpa only [Multiset.mem_cons, mem_insert] using h) =
            Pi.cons s a b e₂ e (by simpa only [Multiset.mem_cons, mem_insert] using h) :=
          by rw [Eq]
        this
#align finset.pi_cons_injective Finset.pi_cons_injective

/- warning: finset.pi_empty -> Finset.pi_empty is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {t : forall (a : α), Finset.{u2} (β a)}, Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a (EmptyCollection.emptyCollection.{u1} (Finset.{u1} α) (Finset.hasEmptyc.{u1} α))) -> (β a))) (Finset.pi.{u1, u2} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) (EmptyCollection.emptyCollection.{u1} (Finset.{u1} α) (Finset.hasEmptyc.{u1} α)) t) (Singleton.singleton.{max u1 u2, max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a (EmptyCollection.emptyCollection.{u1} (Finset.{u1} α) (Finset.hasEmptyc.{u1} α))) -> (β a)) (Finset.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a (EmptyCollection.emptyCollection.{u1} (Finset.{u1} α) (Finset.hasEmptyc.{u1} α))) -> (β a))) (Finset.hasSingleton.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a (EmptyCollection.emptyCollection.{u1} (Finset.{u1} α) (Finset.hasEmptyc.{u1} α))) -> (β a))) (Finset.Pi.empty.{u1, succ u2} α β))
but is expected to have type
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {t : forall (a : α), Finset.{u2} (β a)}, Eq.{max (succ u2) (succ u1)} (Finset.{max u2 u1} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a (EmptyCollection.emptyCollection.{u1} (Finset.{u1} α) (Finset.instEmptyCollectionFinset.{u1} α))) -> (β a))) (Finset.pi.{u2, u1} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) (EmptyCollection.emptyCollection.{u1} (Finset.{u1} α) (Finset.instEmptyCollectionFinset.{u1} α)) t) (Singleton.singleton.{max u2 u1, max u2 u1} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a (EmptyCollection.emptyCollection.{u1} (Finset.{u1} α) (Finset.instEmptyCollectionFinset.{u1} α))) -> (β a)) (Finset.{max u2 u1} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a (EmptyCollection.emptyCollection.{u1} (Finset.{u1} α) (Finset.instEmptyCollectionFinset.{u1} α))) -> (β a))) (Finset.instSingletonFinset.{max u2 u1} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a (EmptyCollection.emptyCollection.{u1} (Finset.{u1} α) (Finset.instEmptyCollectionFinset.{u1} α))) -> (β a))) (Finset.Pi.empty.{u1, succ u2} α β))
Case conversion may be inaccurate. Consider using '#align finset.pi_empty Finset.pi_emptyₓ'. -/
@[simp]
theorem pi_empty {t : ∀ a : α, Finset (β a)} : pi (∅ : Finset α) t = singleton (Pi.empty β) :=
  rfl
#align finset.pi_empty Finset.pi_empty

/- warning: finset.pi_insert -> Finset.pi_insert is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : forall (a : α), DecidableEq.{succ u2} (β a)] {s : Finset.{u1} α} {t : forall (a : α), Finset.{u2} (β a)} {a : α}, (Not (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s)) -> (Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (forall (a_1 : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a_1 (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.hasInsert.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (β a_1))) (Finset.pi.{u1, u2} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.hasInsert.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s) t) (Finset.bunionᵢ.{u2, max u1 u2} (β a) (forall (a_1 : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a_1 (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.hasInsert.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (β a_1)) (fun (a_1 : forall (a_1 : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a_1 (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.hasInsert.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (β a_1)) (b : forall (a_1 : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a_1 (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.hasInsert.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (β a_1)) => Finset.decidableEqPiFinset.{u1, u2} α (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.hasInsert.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s) (fun (a : α) => β a) (fun (a : α) (a_1 : β a) (b : β a) => _inst_2 a a_1 b) a_1 b) (t a) (fun (b : β a) => Finset.image.{max u1 u2, max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (β a)) (forall (a_1 : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a_1 (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.hasInsert.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (β a_1)) (fun (a_1 : forall (a_1 : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a_1 (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.hasInsert.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (β a_1)) (b : forall (a_1 : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a_1 (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.hasInsert.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (β a_1)) => Finset.decidableEqPiFinset.{u1, u2} α (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.hasInsert.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s) (fun (a : α) => β a) (fun (a : α) (a_1 : β a) (b : β a) => _inst_2 a a_1 b) a_1 b) (Finset.Pi.cons.{u1, succ u2} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) s a b) (Finset.pi.{u1, u2} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) s t))))
but is expected to have type
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : forall (a : α), DecidableEq.{succ u2} (β a)] {s : Finset.{u1} α} {t : forall (a : α), Finset.{u2} (β a)} {a : α}, (Not (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s)) -> (Eq.{max (succ u2) (succ u1)} (Finset.{max u2 u1} (forall (a_1 : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a_1 (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.instInsertFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (β a_1))) (Finset.pi.{u2, u1} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.instInsertFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s) t) (Finset.bunionᵢ.{u2, max u2 u1} (β a) (forall (a_1 : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a_1 (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.instInsertFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (β a_1)) (fun (a_1 : forall (a_1 : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a_1 (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.instInsertFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (β a_1)) (b : forall (a_1 : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a_1 (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.instInsertFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (β a_1)) => Finset.decidableEqPiFinset.{u1, u2} α (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.instInsertFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s) (fun (a : α) => β a) (fun (a : α) => (fun (a : α) (a_1 : β a) (b : β a) => _inst_2 a a_1 b) a) a_1 b) (t a) (fun (b : β a) => Finset.image.{max u2 u1, max u2 u1} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (β a)) (forall (a_1 : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a_1 (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.instInsertFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (β a_1)) (fun (a_1 : forall (a_1 : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a_1 (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.instInsertFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (β a_1)) (b : forall (a_1 : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a_1 (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.instInsertFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s)) -> (β a_1)) => Finset.decidableEqPiFinset.{u1, u2} α (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.instInsertFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a s) (fun (a : α) => β a) (fun (a : α) => (fun (a : α) (a_1 : β a) (b : β a) => _inst_2 a a_1 b) a) a_1 b) (Finset.Pi.cons.{succ u2, u1} α β (fun (a : α) (b : α) => _inst_1 a b) s a b) (Finset.pi.{u2, u1} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) s t))))
Case conversion may be inaccurate. Consider using '#align finset.pi_insert Finset.pi_insertₓ'. -/
@[simp]
theorem pi_insert [∀ a, DecidableEq (β a)] {s : Finset α} {t : ∀ a : α, Finset (β a)} {a : α}
    (ha : a ∉ s) : pi (insert a s) t = (t a).bunionᵢ fun b => (pi s t).image (Pi.cons s a b) :=
  by
  apply eq_of_veq
  rw [← (pi (insert a s) t).2.dedup]
  refine'
    (fun s' (h : s' = a ::ₘ s.1) =>
        (_ :
          dedup (Multiset.pi s' fun a => (t a).1) =
            dedup
              ((t a).1.bind fun b =>
                dedup <|
                  (Multiset.pi s.1 fun a : α => (t a).val).map fun f a' h' =>
                    Multiset.Pi.cons s.1 a b f a' (h ▸ h'))))
      _ (insert_val_of_not_mem ha)
  subst s'; rw [pi_cons]
  congr ; funext b
  refine' ((pi s t).Nodup.map _).dedup.symm
  exact Multiset.pi_cons_injective ha
#align finset.pi_insert Finset.pi_insert

/- warning: finset.pi_singletons -> Finset.pi_singletons is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {β : Type.{u2}} (s : Finset.{u1} α) (f : α -> β), Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> β)) (Finset.pi.{u1, u2} α (fun (a : α) => β) (fun (a : α) (b : α) => _inst_1 a b) s (fun (a : α) => Singleton.singleton.{u2, u2} β (Finset.{u2} β) (Finset.hasSingleton.{u2} β) (f a))) (Singleton.singleton.{max u1 u2, max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> β) (Finset.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> β)) (Finset.hasSingleton.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> β)) (fun (a : α) (_x : Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) => f a))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {β : Type.{u2}} (s : Finset.{u1} α) (f : α -> β), Eq.{max (succ u1) (succ u2)} (Finset.{max u2 u1} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> β)) (Finset.pi.{u2, u1} α (fun (a : α) => β) (fun (a : α) (b : α) => _inst_1 a b) s (fun (a : α) => Singleton.singleton.{u2, u2} β (Finset.{u2} β) (Finset.instSingletonFinset.{u2} β) (f a))) (Singleton.singleton.{max u1 u2, max u1 u2} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> β) (Finset.{max u2 u1} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> β)) (Finset.instSingletonFinset.{max u1 u2} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> β)) (fun (a : α) (_x : Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) => f a))
Case conversion may be inaccurate. Consider using '#align finset.pi_singletons Finset.pi_singletonsₓ'. -/
theorem pi_singletons {β : Type _} (s : Finset α) (f : α → β) :
    (s.pi fun a => ({f a} : Finset β)) = {fun a _ => f a} :=
  by
  rw [eq_singleton_iff_unique_mem]
  constructor
  · simp
  intro a ha
  ext (i hi)
  rw [mem_pi] at ha
  simpa using ha i hi
#align finset.pi_singletons Finset.pi_singletons

/- warning: finset.pi_const_singleton -> Finset.pi_const_singleton is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {β : Type.{u2}} (s : Finset.{u1} α) (i : β), Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> β)) (Finset.pi.{u1, u2} α (fun (_x : α) => β) (fun (a : α) (b : α) => _inst_1 a b) s (fun (_x : α) => Singleton.singleton.{u2, u2} β (Finset.{u2} β) (Finset.hasSingleton.{u2} β) i)) (Singleton.singleton.{max u1 u2, max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> β) (Finset.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> β)) (Finset.hasSingleton.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> β)) (fun (_x : α) (_x : Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) _x s) => i))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {β : Type.{u2}} (s : Finset.{u1} α) (i : β), Eq.{max (succ u1) (succ u2)} (Finset.{max u2 u1} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> β)) (Finset.pi.{u2, u1} α (fun (_x : α) => β) (fun (a : α) (b : α) => _inst_1 a b) s (fun (_x : α) => Singleton.singleton.{u2, u2} β (Finset.{u2} β) (Finset.instSingletonFinset.{u2} β) i)) (Singleton.singleton.{max u1 u2, max u1 u2} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> β) (Finset.{max u2 u1} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> β)) (Finset.instSingletonFinset.{max u1 u2} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> β)) (fun (_x : α) (_x : Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) _x s) => i))
Case conversion may be inaccurate. Consider using '#align finset.pi_const_singleton Finset.pi_const_singletonₓ'. -/
theorem pi_const_singleton {β : Type _} (s : Finset α) (i : β) :
    (s.pi fun _ => ({i} : Finset β)) = {fun _ _ => i} :=
  pi_singletons s fun _ => i
#align finset.pi_const_singleton Finset.pi_const_singleton

/- warning: finset.pi_subset -> Finset.pi_subset is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {s : Finset.{u1} α} (t₁ : forall (a : α), Finset.{u2} (β a)) (t₂ : forall (a : α), Finset.{u2} (β a)), (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (HasSubset.Subset.{u2} (Finset.{u2} (β a)) (Finset.hasSubset.{u2} (β a)) (t₁ a) (t₂ a))) -> (HasSubset.Subset.{max u1 u2} (Finset.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (β a))) (Finset.hasSubset.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (β a))) (Finset.pi.{u1, u2} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) s t₁) (Finset.pi.{u1, u2} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) s t₂))
but is expected to have type
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {s : Finset.{u1} α} (t₁ : forall (a : α), Finset.{u2} (β a)) (t₂ : forall (a : α), Finset.{u2} (β a)), (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (HasSubset.Subset.{u2} (Finset.{u2} (β a)) (Finset.instHasSubsetFinset.{u2} (β a)) (t₁ a) (t₂ a))) -> (HasSubset.Subset.{max u1 u2} (Finset.{max u2 u1} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (β a))) (Finset.instHasSubsetFinset.{max u2 u1} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (β a))) (Finset.pi.{u2, u1} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) s t₁) (Finset.pi.{u2, u1} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) s t₂))
Case conversion may be inaccurate. Consider using '#align finset.pi_subset Finset.pi_subsetₓ'. -/
theorem pi_subset {s : Finset α} (t₁ t₂ : ∀ a, Finset (β a)) (h : ∀ a ∈ s, t₁ a ⊆ t₂ a) :
    s.pi t₁ ⊆ s.pi t₂ := fun g hg => mem_pi.2 fun a ha => h a ha (mem_pi.mp hg a ha)
#align finset.pi_subset Finset.pi_subset

/- warning: finset.pi_disjoint_of_disjoint -> Finset.pi_disjoint_of_disjoint is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {δ : α -> Type.{u2}} {s : Finset.{u1} α} (t₁ : forall (a : α), Finset.{u2} (δ a)) (t₂ : forall (a : α), Finset.{u2} (δ a)) {a : α}, (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (Disjoint.{u2} (Finset.{u2} (δ a)) (Finset.partialOrder.{u2} (δ a)) (Finset.orderBot.{u2} (δ a)) (t₁ a) (t₂ a)) -> (Disjoint.{max u1 u2} (Finset.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (δ a))) (Finset.partialOrder.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (δ a))) (Finset.orderBot.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) -> (δ a))) (Finset.pi.{u1, u2} α (fun (a : α) => δ a) (fun (a : α) (b : α) => _inst_1 a b) s t₁) (Finset.pi.{u1, u2} α (fun (a : α) => δ a) (fun (a : α) (b : α) => _inst_1 a b) s t₂))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {δ : α -> Type.{u2}} {s : Finset.{u1} α} (t₁ : forall (a : α), Finset.{u2} (δ a)) (t₂ : forall (a : α), Finset.{u2} (δ a)) {a : α}, (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (Disjoint.{u2} (Finset.{u2} (δ a)) (Finset.partialOrder.{u2} (δ a)) (Finset.instOrderBotFinsetToLEToPreorderPartialOrder.{u2} (δ a)) (t₁ a) (t₂ a)) -> (Disjoint.{max u1 u2} (Finset.{max u2 u1} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (δ a))) (Finset.partialOrder.{max u1 u2} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (δ a))) (Finset.instOrderBotFinsetToLEToPreorderPartialOrder.{max u1 u2} (forall (a : α), (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) -> (δ a))) (Finset.pi.{u2, u1} α (fun (a : α) => δ a) (fun (a : α) (b : α) => _inst_1 a b) s t₁) (Finset.pi.{u2, u1} α (fun (a : α) => δ a) (fun (a : α) (b : α) => _inst_1 a b) s t₂))
Case conversion may be inaccurate. Consider using '#align finset.pi_disjoint_of_disjoint Finset.pi_disjoint_of_disjointₓ'. -/
theorem pi_disjoint_of_disjoint {δ : α → Type _} {s : Finset α} (t₁ t₂ : ∀ a, Finset (δ a)) {a : α}
    (ha : a ∈ s) (h : Disjoint (t₁ a) (t₂ a)) : Disjoint (s.pi t₁) (s.pi t₂) :=
  disjoint_iff_ne.2 fun f₁ hf₁ f₂ hf₂ eq₁₂ =>
    disjoint_iff_ne.1 h (f₁ a ha) (mem_pi.mp hf₁ a ha) (f₂ a ha) (mem_pi.mp hf₂ a ha) <|
      congr_fun (congr_fun eq₁₂ a) ha
#align finset.pi_disjoint_of_disjoint Finset.pi_disjoint_of_disjoint

end Pi

end Finset


/-
Copyright (c) 2021 Alex Kontorovich, Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex Kontorovich, Heather Macbeth
-/
import topology.homeomorph
import group_theory.group_action.basic
/-!
# Monoid actions continuous in the second variable

In this file we define class `has_continuous_const_smul`. We say `has_continuous_const_smul Γ T` if
`Γ` acts on `T` and for each `γ`, the map `x ↦ γ • x` is continuous. (This differs from
`has_continuous_smul`, which requires simultaneous continuity in both variables.)

## Main definitions

* `has_continuous_const_smul Γ T` : typeclass saying that the map `x ↦ γ • x` is continuous on `T`;
* `properly_discontinuous_smul`: says that the scalar multiplication `(•) : Γ → T → T`
  is properly discontinuous, that is, for any pair of compact sets `K, L` in `T`, only finitely
  many `γ:Γ` move `K` to have nontrivial intersection with `L`.
* `homeomorph.smul`: scalar multiplication by an element of a group `Γ` acting on `T`
  is a homeomorphism of `T`.

## Main results

* `is_open_map_quotient_mk_mul` : The quotient map by a group action is open.
* `t2_space_of_properly_discontinuous_smul_of_t2_space` : The quotient by a discontinuous group
  action of a locally compact t2 space is t2.

## Tags

Hausdorff, discrete group, properly discontinuous, quotient space

-/

open_locale topological_space pointwise

open filter set

local attribute [instance] mul_action.orbit_rel

/-- Class `has_continuous_const_smul Γ T` says that the scalar multiplication `(•) : Γ → T → T`
is continuous in the second argument. We use the same class for all kinds of multiplicative
actions, including (semi)modules and algebras.
-/
class has_continuous_const_smul (Γ : Type*) (T : Type*) [topological_space T] [has_scalar Γ T]
 : Prop :=
(continuous_const_smul : ∀ γ : Γ, continuous (λ x : T, γ • x))

/-- Class `has_continuous_const_vadd Γ T` says that the additive action `(+ᵥ) : Γ → T → T`
is continuous in the second argument. We use the same class for all kinds of additive actions,
including (semi)modules and algebras.
-/
class has_continuous_const_vadd (Γ : Type*) (T : Type*) [topological_space T]
  [has_vadd Γ T] : Prop :=
(continuous_const_vadd : ∀ γ : Γ, continuous (λ x : T, γ +ᵥ x))

attribute [to_additive] has_continuous_const_smul

export has_continuous_const_smul (continuous_const_smul)

export has_continuous_const_vadd (continuous_const_vadd)

variables {M α β : Type*}

section has_scalar
variables [topological_space α] [has_scalar M α] [has_continuous_const_smul M α]

@[to_additive]
lemma filter.tendsto.const_smul {f : β → α} {l : filter β} {a : α} (hf : tendsto f l (𝓝 a))
  (c : M) :
  tendsto (λ x, c • f x) l (𝓝 (c • a)) :=
((continuous_const_smul _).tendsto _).comp hf

variables [topological_space β] {f : β → M} {g : β → α} {b : β} {s : set β}

@[to_additive]
lemma continuous_within_at.const_smul (hg : continuous_within_at g s b) (c : M) :
  continuous_within_at (λ x, c • g x) s b :=
hg.const_smul c

@[to_additive]
lemma continuous_at.const_smul (hg : continuous_at g b) (c : M) :
  continuous_at (λ x, c • g x) b :=
hg.const_smul c

@[to_additive]
lemma continuous_on.const_smul (hg : continuous_on g s) (c : M) :
  continuous_on (λ x, c • g x) s :=
λ x hx, (hg x hx).const_smul c

@[continuity, to_additive]
lemma continuous.const_smul (hg : continuous g) (c : M) :
  continuous (λ x, c • g x) :=
(continuous_const_smul _).comp hg

/-- If a scalar is central, then its right action is continuous when its left action is. -/
instance has_continuous_const_smul.op [has_scalar Mᵐᵒᵖ α] [is_central_scalar M α] :
  has_continuous_const_smul Mᵐᵒᵖ α :=
⟨ mul_opposite.rec $ λ c, by simpa only [op_smul_eq_smul] using continuous_const_smul c ⟩

@[to_additive]
instance [has_scalar M β] [has_continuous_const_smul M β] :
  has_continuous_const_smul M (α × β) :=
⟨λ _, (continuous_fst.const_smul _).prod_mk (continuous_snd.const_smul _)⟩

@[to_additive]
instance {ι : Type*} {γ : ι → Type*} [∀ i, topological_space (γ i)] [Π i, has_scalar M (γ i)]
  [∀ i, has_continuous_const_smul M (γ i)] : has_continuous_const_smul M (Π i, γ i) :=
⟨λ _, continuous_pi $ λ i, (continuous_apply i).const_smul _⟩

end has_scalar

section monoid

variables [topological_space α]
variables [monoid M] [mul_action M α] [has_continuous_const_smul M α]

@[to_additive] instance units.has_continuous_const_smul : has_continuous_const_smul Mˣ α :=
{ continuous_const_smul := λ m, (continuous_const_smul (m : M) : _) }

@[to_additive]
lemma smul_closure_subset (c : M) (s : set α) : c • closure s ⊆ closure (c • s) :=
((set.maps_to_image _ _).closure $ continuous_id.const_smul c).image_subset

@[to_additive]
lemma smul_closure_orbit_subset (c : M) (x : α) :
  c • closure (mul_action.orbit M x) ⊆ closure (mul_action.orbit M x) :=
(smul_closure_subset c _).trans $ closure_mono $ mul_action.smul_orbit_subset _ _

end monoid

section group

variables {G : Type*} [topological_space α] [group G] [mul_action G α]
  [has_continuous_const_smul G α]

@[to_additive]
lemma tendsto_const_smul_iff {f : β → α} {l : filter β} {a : α} (c : G) :
  tendsto (λ x, c • f x) l (𝓝 $ c • a) ↔ tendsto f l (𝓝 a) :=
⟨λ h, by simpa only [inv_smul_smul] using h.const_smul c⁻¹,
  λ h, h.const_smul _⟩

variables [topological_space β] {f : β → α} {b : β}  {s : set β}

@[to_additive]
lemma continuous_within_at_const_smul_iff (c : G) :
  continuous_within_at (λ x, c • f x) s b ↔ continuous_within_at f s b :=
tendsto_const_smul_iff c

@[to_additive]
lemma continuous_on_const_smul_iff (c : G) : continuous_on (λ x, c • f x) s ↔ continuous_on f s :=
forall₂_congr $ λ b hb, continuous_within_at_const_smul_iff c

@[to_additive]
lemma continuous_at_const_smul_iff (c : G) :
  continuous_at (λ x, c • f x) b ↔ continuous_at f b :=
tendsto_const_smul_iff c

@[to_additive]
lemma continuous_const_smul_iff (c : G) :
  continuous (λ x, c • f x) ↔ continuous f :=
by simp only [continuous_iff_continuous_at, continuous_at_const_smul_iff]

/-- The homeomorphism given by scalar multiplication by a given element of a group `Γ` acting on
  `T` is a homeomorphism from `T` to itself. -/
@[to_additive] def homeomorph.smul (γ : G) : α ≃ₜ α :=
{ to_equiv := mul_action.to_perm γ,
  continuous_to_fun  := continuous_const_smul γ,
  continuous_inv_fun := continuous_const_smul γ⁻¹ }

/-- The homeomorphism given by affine-addition by an element of an additive group `Γ` acting on
  `T` is a homeomorphism from `T` to itself. -/
add_decl_doc homeomorph.vadd

@[to_additive]
lemma is_open_map_smul (c : G) : is_open_map (λ x : α, c • x) :=
(homeomorph.smul c).is_open_map

@[to_additive] lemma is_open.smul {s : set α} (hs : is_open s) (c : G) : is_open (c • s) :=
is_open_map_smul c s hs

@[to_additive]
lemma is_closed_map_smul (c : G) : is_closed_map (λ x : α, c • x) :=
(homeomorph.smul c).is_closed_map

@[to_additive] lemma is_closed.smul {s : set α} (hs : is_closed s) (c : G) : is_closed (c • s) :=
is_closed_map_smul c s hs

@[to_additive] lemma closure_smul (c : G) (s : set α) : closure (c • s) = c • closure s :=
((homeomorph.smul c).image_closure s).symm

@[to_additive] lemma interior_smul (c : G) (s : set α) : interior (c • s) = c • interior s :=
((homeomorph.smul c).image_interior s).symm

end group

section group_with_zero

variables {G₀ : Type*} [topological_space α] [group_with_zero G₀] [mul_action G₀ α]
  [has_continuous_const_smul G₀ α]

lemma tendsto_const_smul_iff₀ {f : β → α} {l : filter β} {a : α} {c : G₀} (hc : c ≠ 0) :
  tendsto (λ x, c • f x) l (𝓝 $ c • a) ↔ tendsto f l (𝓝 a) :=
tendsto_const_smul_iff (units.mk0 c hc)

variables [topological_space β] {f : β → α} {b : β} {c : G₀} {s : set β}

lemma continuous_within_at_const_smul_iff₀ (hc : c ≠ 0) :
  continuous_within_at (λ x, c • f x) s b ↔ continuous_within_at f s b :=
tendsto_const_smul_iff (units.mk0 c hc)

lemma continuous_on_const_smul_iff₀ (hc : c ≠ 0) :
  continuous_on (λ x, c • f x) s ↔ continuous_on f s :=
continuous_on_const_smul_iff (units.mk0 c hc)

lemma continuous_at_const_smul_iff₀ (hc : c ≠ 0) :
  continuous_at (λ x, c • f x) b ↔ continuous_at f b :=
continuous_at_const_smul_iff (units.mk0 c hc)

lemma continuous_const_smul_iff₀ (hc : c ≠ 0) :
  continuous (λ x, c • f x) ↔ continuous f :=
continuous_const_smul_iff (units.mk0 c hc)

/-- Scalar multiplication by a non-zero element of a group with zero acting on `α` is a
homeomorphism from `α` onto itself. -/
protected def homeomorph.smul_of_ne_zero (c : G₀) (hc : c ≠ 0) : α ≃ₜ α :=
homeomorph.smul (units.mk0 c hc)

lemma is_open_map_smul₀ {c : G₀} (hc : c ≠ 0) : is_open_map (λ x : α, c • x) :=
(homeomorph.smul_of_ne_zero c hc).is_open_map

lemma is_open.smul₀ {c : G₀} {s : set α} (hs : is_open s) (hc : c ≠ 0) : is_open (c • s) :=
is_open_map_smul₀ hc s hs

lemma interior_smul₀ {c : G₀} (hc : c ≠ 0) (s : set α) : interior (c • s) = c • interior s :=
((homeomorph.smul_of_ne_zero c hc).image_interior s).symm

lemma closure_smul₀ {E} [has_zero E] [mul_action_with_zero G₀ E] [topological_space E]
  [t1_space E] [has_continuous_const_smul G₀ E] (c : G₀) (s : set E) :
  closure (c • s) = c • closure s :=
begin
  rcases eq_or_ne c 0 with rfl|hc,
  { rcases eq_empty_or_nonempty s with rfl|hs,
    { simp },
    { rw [zero_smul_set hs, zero_smul_set hs.closure], exact closure_singleton } },
  { exact ((homeomorph.smul_of_ne_zero c hc).image_closure s).symm }
end

/-- `smul` is a closed map in the second argument.

The lemma that `smul` is a closed map in the first argument (for a normed space over a complete
normed field) is `is_closed_map_smul_left` in `analysis.normed_space.finite_dimension`. -/
lemma is_closed_map_smul_of_ne_zero {c : G₀} (hc : c ≠ 0) : is_closed_map (λ x : α, c • x) :=
(homeomorph.smul_of_ne_zero c hc).is_closed_map

lemma is_closed.smul_of_ne_zero {c : G₀} {s : set α} (hs : is_closed s) (hc : c ≠ 0) :
  is_closed (c • s) :=
is_closed_map_smul_of_ne_zero hc s hs

/-- `smul` is a closed map in the second argument.

The lemma that `smul` is a closed map in the first argument (for a normed space over a complete
normed field) is `is_closed_map_smul_left` in `analysis.normed_space.finite_dimension`. -/
lemma is_closed_map_smul₀ {𝕜 M : Type*} [division_ring 𝕜] [add_comm_monoid M] [topological_space M]
  [t1_space M] [module 𝕜 M] [has_continuous_const_smul 𝕜 M] (c : 𝕜) :
  is_closed_map (λ x : M, c • x) :=
begin
  rcases eq_or_ne c 0 with (rfl|hne),
  { simp only [zero_smul], exact is_closed_map_const },
  { exact (homeomorph.smul_of_ne_zero c hne).is_closed_map },
end

lemma is_closed.smul₀ {𝕜 M : Type*} [division_ring 𝕜] [add_comm_monoid M] [topological_space M]
  [t1_space M] [module 𝕜 M] [has_continuous_const_smul 𝕜 M] (c : 𝕜) {s : set M} (hs : is_closed s) :
  is_closed (c • s) :=
is_closed_map_smul₀ c s hs

end group_with_zero

namespace is_unit

variables [monoid M] [topological_space α] [mul_action M α] [has_continuous_const_smul M α]

lemma tendsto_const_smul_iff {f : β → α} {l : filter β} {a : α} {c : M} (hc : is_unit c) :
  tendsto (λ x, c • f x) l (𝓝 $ c • a) ↔ tendsto f l (𝓝 a) :=
let ⟨u, hu⟩ := hc in hu ▸ tendsto_const_smul_iff u

variables [topological_space β] {f : β → α} {b : β} {c : M} {s : set β}

lemma continuous_within_at_const_smul_iff (hc : is_unit c) :
  continuous_within_at (λ x, c • f x) s b ↔ continuous_within_at f s b :=
let ⟨u, hu⟩ := hc in hu ▸ continuous_within_at_const_smul_iff u

lemma continuous_on_const_smul_iff (hc : is_unit c) :
  continuous_on (λ x, c • f x) s ↔ continuous_on f s :=
let ⟨u, hu⟩ := hc in hu ▸ continuous_on_const_smul_iff u

lemma continuous_at_const_smul_iff (hc : is_unit c) :
  continuous_at (λ x, c • f x) b ↔ continuous_at f b :=
let ⟨u, hu⟩ := hc in hu ▸ continuous_at_const_smul_iff u

lemma continuous_const_smul_iff (hc : is_unit c) :
  continuous (λ x, c • f x) ↔ continuous f :=
let ⟨u, hu⟩ := hc in hu ▸ continuous_const_smul_iff u

lemma is_open_map_smul (hc : is_unit c) : is_open_map (λ x : α, c • x) :=
let ⟨u, hu⟩ := hc in hu ▸ is_open_map_smul u

lemma is_closed_map_smul (hc : is_unit c) : is_closed_map (λ x : α, c • x) :=
let ⟨u, hu⟩ := hc in hu ▸ is_closed_map_smul u

end is_unit

/-- Class `properly_discontinuous_smul Γ T` says that the scalar multiplication `(•) : Γ → T → T`
is properly discontinuous, that is, for any pair of compact sets `K, L` in `T`, only finitely many
`γ:Γ` move `K` to have nontrivial intersection with `L`.
-/
class properly_discontinuous_smul (Γ : Type*) (T : Type*) [topological_space T]
  [has_scalar Γ T] : Prop :=
(finite_disjoint_inter_image : ∀ {K L : set T}, is_compact K → is_compact L →
  set.finite {γ : Γ | (((•) γ) '' K) ∩ L ≠ ∅ })

/-- Class `properly_discontinuous_vadd Γ T` says that the additive action `(+ᵥ) : Γ → T → T`
is properly discontinuous, that is, for any pair of compact sets `K, L` in `T`, only finitely many
`γ:Γ` move `K` to have nontrivial intersection with `L`.
-/
class properly_discontinuous_vadd (Γ : Type*) (T : Type*) [topological_space T]
  [has_vadd Γ T] : Prop :=
(finite_disjoint_inter_image : ∀ {K L : set T}, is_compact K → is_compact L →
  set.finite {γ : Γ | (((+ᵥ) γ) '' K) ∩ L ≠ ∅ })

attribute [to_additive] properly_discontinuous_smul

variables {Γ : Type*} [group Γ] {T : Type*} [topological_space T] [mul_action Γ T]

/-- A finite group action is always properly discontinuous
-/
@[priority 100, to_additive] instance fintype.properly_discontinuous_smul [fintype Γ] :
  properly_discontinuous_smul Γ T :=
{ finite_disjoint_inter_image := λ _ _ _ _, set.finite.of_fintype _}

export properly_discontinuous_smul (finite_disjoint_inter_image)

export properly_discontinuous_vadd (finite_disjoint_inter_image)

/-- The quotient map by a group action is open. -/
@[to_additive]
lemma is_open_map_quotient_mk_mul [has_continuous_const_smul Γ T] :
  is_open_map (quotient.mk : T → quotient (mul_action.orbit_rel Γ T)) :=
begin
  intros U hU,
  rw [is_open_coinduced, mul_action.quotient_preimage_image_eq_union_mul U],
  exact is_open_Union (λ γ, (homeomorph.smul γ).is_open_map U hU)
end

/-- The quotient by a discontinuous group action of a locally compact t2 space is t2. -/
@[priority 100, to_additive] instance t2_space_of_properly_discontinuous_smul_of_t2_space
  [t2_space T] [locally_compact_space T] [has_continuous_const_smul Γ T]
  [properly_discontinuous_smul Γ T] : t2_space (quotient (mul_action.orbit_rel Γ T)) :=
begin
  set Q := quotient (mul_action.orbit_rel Γ T),
  rw t2_space_iff_nhds,
  let f : T → Q := quotient.mk,
  have f_op : is_open_map f := is_open_map_quotient_mk_mul,
  rintros ⟨x₀⟩ ⟨y₀⟩ (hxy : f x₀ ≠ f y₀),
  show ∃ (U ∈ 𝓝 (f x₀)) (V ∈ 𝓝 (f y₀)), U ∩ V = ∅,
  have hx₀y₀ : x₀ ≠ y₀ := ne_of_apply_ne _ hxy,
  have hγx₀y₀ : ∀ γ : Γ, γ • x₀ ≠ y₀ := not_exists.mp (mt quotient.sound hxy.symm : _),
  obtain ⟨K₀, L₀, K₀_in, L₀_in, hK₀, hL₀, hK₀L₀⟩ := t2_separation_compact_nhds hx₀y₀,
  let bad_Γ_set := {γ : Γ | (((•) γ) '' K₀) ∩ L₀ ≠ ∅ },
  have bad_Γ_finite : bad_Γ_set.finite := finite_disjoint_inter_image hK₀ hL₀,
  choose u v hu hv u_v_disjoint using λ γ, t2_separation_nhds (hγx₀y₀ γ),
  let U₀₀ := ⋂ γ ∈ bad_Γ_set, ((•) γ) ⁻¹' (u γ),
  let U₀ := U₀₀ ∩ K₀,
  let V₀₀ := ⋂ γ ∈ bad_Γ_set, v γ,
  let V₀ := V₀₀ ∩ L₀,
  have U_nhds : f '' U₀ ∈ 𝓝 (f x₀),
  { apply f_op.image_mem_nhds (inter_mem ((bInter_mem bad_Γ_finite).mpr $ λ γ hγ, _) K₀_in),
    exact (continuous_const_smul _).continuous_at (hu γ) },
  have V_nhds : f '' V₀ ∈ 𝓝 (f y₀),
    from f_op.image_mem_nhds (inter_mem ((bInter_mem bad_Γ_finite).mpr $ λ γ hγ, hv γ) L₀_in),
  refine ⟨f '' U₀, U_nhds, f '' V₀, V_nhds, _⟩,
  rw mul_action.image_inter_image_iff,
  rintros x ⟨x_in_U₀₀, x_in_K₀⟩ γ,
  by_cases H : γ ∈ bad_Γ_set,
  { rintros ⟨h, -⟩,
    exact eq_empty_iff_forall_not_mem.mp (u_v_disjoint γ) (γ • x)
      ⟨(mem_Inter₂.mp x_in_U₀₀ γ H : _), mem_Inter₂.mp h γ H⟩ },
  { rintros ⟨-, h'⟩,
    simp only [image_smul, not_not, mem_set_of_eq, ne.def] at H,
    exact eq_empty_iff_forall_not_mem.mp H (γ • x) ⟨mem_image_of_mem _ x_in_K₀, h'⟩ },
end

section nhds

section mul_action

variables {G₀ : Type*} [group_with_zero G₀] [mul_action G₀ α]
  [topological_space α] [has_continuous_const_smul G₀ α]

/-- Scalar multiplication preserves neighborhoods. -/
lemma set_smul_mem_nhds_smul {c : G₀} {s : set α} {x : α} (hs : s ∈ 𝓝 x) (hc : c ≠ 0) :
  c • s ∈ 𝓝 (c • x : α) :=
begin
  rw mem_nhds_iff at hs ⊢,
  obtain ⟨U, hs', hU, hU'⟩ := hs,
  exact ⟨c • U, set.smul_set_mono hs', hU.smul₀ hc, set.smul_mem_smul_set hU'⟩,
end

lemma set_smul_mem_nhds_smul_iff {c : G₀} {s : set α} {x : α} (hc : c ≠ 0) :
  c • s ∈ 𝓝 (c • x : α) ↔ s ∈ 𝓝 x :=
begin
  refine ⟨λ h, _, λ h, set_smul_mem_nhds_smul h hc⟩,
  rw [←inv_smul_smul₀ hc x, ←inv_smul_smul₀ hc s],
  exact set_smul_mem_nhds_smul h (inv_ne_zero hc),
end

end mul_action

section distrib_mul_action

variables {G₀ : Type*} [group_with_zero G₀] [add_monoid α] [distrib_mul_action G₀ α]
  [topological_space α] [has_continuous_const_smul G₀ α]

lemma set_smul_mem_nhds_zero_iff {s : set α} {c : G₀} (hc : c ≠ 0) :
  c • s ∈ 𝓝 (0 : α) ↔ s ∈ 𝓝 (0 : α) :=
begin
  refine iff.trans _ (set_smul_mem_nhds_smul_iff hc),
  rw smul_zero,
end

end distrib_mul_action

end nhds


/-
Copyright (c) 2022 Moritz Doll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Moritz Doll, Anatole Dedecker
-/

import analysis.seminorm
import analysis.locally_convex.bounded

/-!
# Topology induced by a family of seminorms

## Main definitions

* `seminorm_family.basis_sets`: The set of open seminorm balls for a family of seminorms.
* `seminorm_family.module_filter_basis`: A module filter basis formed by the open balls.
* `seminorm.is_bounded`: A linear map `f : E →ₗ[𝕜] F` is bounded iff every seminorm in `F` can be
bounded by a finite number of seminorms in `E`.

## Main statements

* `continuous_from_bounded`: A bounded linear map `f : E →ₗ[𝕜] F` is continuous.
* `seminorm_family.to_locally_convex_space`: A space equipped with a family of seminorms is locally
convex.

## TODO

Show that for any locally convex space there exist seminorms that induce the topology.

## Tags

seminorm, locally convex
-/

open normed_field set seminorm topological_space
open_locale big_operators nnreal pointwise topological_space

variables {𝕜 E F G ι ι' : Type*}

section filter_basis

variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E]

variables (𝕜 E ι)

/-- An abbreviation for indexed families of seminorms. This is mainly to allow for dot-notation. -/
abbreviation seminorm_family := ι → seminorm 𝕜 E

variables {𝕜 E ι}

namespace seminorm_family

/-- The sets of a filter basis for the neighborhood filter of 0. -/
def basis_sets (p : seminorm_family 𝕜 E ι) : set (set E) :=
⋃ (s : finset ι) r (hr : 0 < r), singleton $ ball (s.sup p) (0 : E) r

variables (p : seminorm_family 𝕜 E ι)

lemma basis_sets_iff {U : set E} :
  U ∈ p.basis_sets ↔ ∃ (i : finset ι) r (hr : 0 < r), U = ball (i.sup p) 0 r :=
by simp only [basis_sets, mem_Union, mem_singleton_iff]

lemma basis_sets_mem (i : finset ι) {r : ℝ} (hr : 0 < r) :
  (i.sup p).ball 0 r ∈ p.basis_sets :=
(basis_sets_iff _).mpr ⟨i,_,hr,rfl⟩

lemma basis_sets_singleton_mem (i : ι) {r : ℝ} (hr : 0 < r) :
  (p i).ball 0 r ∈ p.basis_sets :=
(basis_sets_iff _).mpr ⟨{i},_,hr, by rw finset.sup_singleton⟩

lemma basis_sets_nonempty [nonempty ι] : p.basis_sets.nonempty :=
begin
  let i := classical.arbitrary ι,
  refine set.nonempty_def.mpr ⟨(p i).ball 0 1, _⟩,
  exact p.basis_sets_singleton_mem i zero_lt_one,
end

lemma basis_sets_intersect
  (U V : set E) (hU : U ∈ p.basis_sets) (hV : V ∈ p.basis_sets) :
  ∃ (z : set E) (H : z ∈ p.basis_sets), z ⊆ U ∩ V :=
begin
  classical,
  rcases p.basis_sets_iff.mp hU with ⟨s, r₁, hr₁, hU⟩,
  rcases p.basis_sets_iff.mp hV with ⟨t, r₂, hr₂, hV⟩,
  use ((s ∪ t).sup p).ball 0 (min r₁ r₂),
  refine ⟨p.basis_sets_mem (s ∪ t) (lt_min_iff.mpr ⟨hr₁, hr₂⟩), _⟩,
  rw [hU, hV, ball_finset_sup_eq_Inter _ _ _ (lt_min_iff.mpr ⟨hr₁, hr₂⟩),
    ball_finset_sup_eq_Inter _ _ _ hr₁, ball_finset_sup_eq_Inter _ _ _ hr₂],
  exact set.subset_inter
    (set.Inter₂_mono' $ λ i hi, ⟨i, finset.subset_union_left _ _ hi, ball_mono $ min_le_left _ _⟩)
    (set.Inter₂_mono' $ λ i hi, ⟨i, finset.subset_union_right _ _ hi, ball_mono $
    min_le_right _ _⟩),
end

lemma basis_sets_zero (U) (hU : U ∈ p.basis_sets) :
  (0 : E) ∈ U :=
begin
  rcases p.basis_sets_iff.mp hU with ⟨ι', r, hr, hU⟩,
  rw [hU, mem_ball_zero, map_zero],
  exact hr,
end

lemma basis_sets_add (U) (hU : U ∈ p.basis_sets) :
  ∃ (V : set E) (H : V ∈ p.basis_sets), V + V ⊆ U :=
begin
  rcases p.basis_sets_iff.mp hU with ⟨s, r, hr, hU⟩,
  use (s.sup p).ball 0 (r/2),
  refine ⟨p.basis_sets_mem s (div_pos hr zero_lt_two), _⟩,
  refine set.subset.trans (ball_add_ball_subset (s.sup p) (r/2) (r/2) 0 0) _,
  rw [hU, add_zero, add_halves'],
end

lemma basis_sets_neg (U) (hU' : U ∈ p.basis_sets) :
  ∃ (V : set E) (H : V ∈ p.basis_sets), V ⊆ (λ (x : E), -x) ⁻¹' U :=
begin
  rcases p.basis_sets_iff.mp hU' with ⟨s, r, hr, hU⟩,
  rw [hU, neg_preimage, neg_ball (s.sup p), neg_zero],
  exact ⟨U, hU', eq.subset hU⟩,
end

/-- The `add_group_filter_basis` induced by the filter basis `seminorm_basis_zero`. -/
protected def add_group_filter_basis [nonempty ι] : add_group_filter_basis E :=
add_group_filter_basis_of_comm p.basis_sets p.basis_sets_nonempty
  p.basis_sets_intersect p.basis_sets_zero p.basis_sets_add p.basis_sets_neg

lemma basis_sets_smul_right (v : E) (U : set E)
  (hU : U ∈ p.basis_sets) : ∀ᶠ (x : 𝕜) in 𝓝 0, x • v ∈ U :=
begin
  rcases p.basis_sets_iff.mp hU with ⟨s, r, hr, hU⟩,
  rw [hU, filter.eventually_iff],
  simp_rw [(s.sup p).mem_ball_zero, (s.sup p).smul],
  by_cases h : 0 < (s.sup p) v,
  { simp_rw (lt_div_iff h).symm,
    rw ←_root_.ball_zero_eq,
    exact metric.ball_mem_nhds 0 (div_pos hr h) },
  simp_rw [le_antisymm (not_lt.mp h) ((s.sup p).nonneg v), mul_zero, hr],
  exact is_open.mem_nhds is_open_univ (mem_univ 0),
end

variables [nonempty ι]

lemma basis_sets_smul (U) (hU : U ∈ p.basis_sets) :
  ∃ (V : set 𝕜) (H : V ∈ 𝓝 (0 : 𝕜)) (W : set E)
  (H : W ∈ p.add_group_filter_basis.sets), V • W ⊆ U :=
begin
  rcases p.basis_sets_iff.mp hU with ⟨s, r, hr, hU⟩,
  refine ⟨metric.ball 0 r.sqrt, metric.ball_mem_nhds 0 (real.sqrt_pos.mpr hr), _⟩,
  refine ⟨(s.sup p).ball 0 r.sqrt, p.basis_sets_mem s (real.sqrt_pos.mpr hr), _⟩,
  refine set.subset.trans (ball_smul_ball (s.sup p) r.sqrt r.sqrt) _,
  rw [hU, real.mul_self_sqrt (le_of_lt hr)],
end

lemma basis_sets_smul_left (x : 𝕜) (U : set E)
  (hU : U ∈ p.basis_sets) : ∃ (V : set E)
  (H : V ∈ p.add_group_filter_basis.sets), V ⊆ (λ (y : E), x • y) ⁻¹' U :=
begin
  rcases p.basis_sets_iff.mp hU with ⟨s, r, hr, hU⟩,
  rw hU,
  by_cases h : x ≠ 0,
  { rw [(s.sup p).smul_ball_preimage 0 r x h, smul_zero],
    use (s.sup p).ball 0 (r / ∥x∥),
    exact ⟨p.basis_sets_mem s (div_pos hr (norm_pos_iff.mpr h)), subset.rfl⟩ },
  refine ⟨(s.sup p).ball 0 r, p.basis_sets_mem s hr, _⟩,
  simp only [not_ne_iff.mp h, subset_def, mem_ball_zero, hr, mem_univ, map_zero,
    implies_true_iff, preimage_const_of_mem, zero_smul],
end

/-- The `module_filter_basis` induced by the filter basis `seminorm_basis_zero`. -/
protected def module_filter_basis : module_filter_basis 𝕜 E :=
{ to_add_group_filter_basis := p.add_group_filter_basis,
  smul' := p.basis_sets_smul,
  smul_left' := p.basis_sets_smul_left,
  smul_right' := p.basis_sets_smul_right }

lemma filter_eq_infi (p : seminorm_family 𝕜 E ι) :
  p.module_filter_basis.to_filter_basis.filter = ⨅ i, (𝓝 0).comap (p i) :=
begin
  refine le_antisymm (le_infi $ λ i, _) _,
  { rw p.module_filter_basis.to_filter_basis.has_basis.le_basis_iff
      (metric.nhds_basis_ball.comap _),
    intros ε hε,
    refine ⟨(p i).ball 0 ε, _, _⟩,
    { rw ← (finset.sup_singleton : _ = p i),
      exact p.basis_sets_mem {i} hε, },
    { rw [id, (p i).ball_zero_eq_preimage_ball] } },
  { rw p.module_filter_basis.to_filter_basis.has_basis.ge_iff,
    rintros U (hU : U ∈ p.basis_sets),
    rcases p.basis_sets_iff.mp hU with ⟨s, r, hr, rfl⟩,
    rw [id, seminorm.ball_finset_sup_eq_Inter _ _ _ hr, s.Inter_mem_sets],
    exact λ i hi, filter.mem_infi_of_mem i ⟨metric.ball 0 r, metric.ball_mem_nhds 0 hr,
      eq.subset ((p i).ball_zero_eq_preimage_ball).symm⟩, },
end

end seminorm_family

end filter_basis

section bounded

namespace seminorm

variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [add_comm_group F] [module 𝕜 F]

-- Todo: This should be phrased entirely in terms of the von Neumann bornology.

/-- The proposition that a linear map is bounded between spaces with families of seminorms. -/
def is_bounded (p : ι → seminorm 𝕜 E) (q : ι' → seminorm 𝕜 F) (f : E →ₗ[𝕜] F) : Prop :=
  ∀ i, ∃ s : finset ι, ∃ C : ℝ≥0, C ≠ 0 ∧ (q i).comp f ≤ C • s.sup p

lemma is_bounded_const (ι' : Type*) [nonempty ι']
  {p : ι → seminorm 𝕜 E} {q : seminorm 𝕜 F} (f : E →ₗ[𝕜] F) :
  is_bounded p (λ _ : ι', q) f ↔ ∃ (s : finset ι) C : ℝ≥0, C ≠ 0 ∧ q.comp f ≤ C • s.sup p :=
by simp only [is_bounded, forall_const]

lemma const_is_bounded (ι : Type*) [nonempty ι]
  {p : seminorm 𝕜 E} {q : ι' → seminorm 𝕜 F} (f : E →ₗ[𝕜] F) :
  is_bounded (λ _ : ι, p) q f ↔ ∀ i, ∃ C : ℝ≥0, C ≠ 0 ∧ (q i).comp f ≤ C • p :=
begin
  split; intros h i,
  { rcases h i with ⟨s, C, hC, h⟩,
    exact ⟨C, hC, le_trans h (smul_le_smul (finset.sup_le (λ _ _, le_rfl)) le_rfl)⟩ },
  use [{classical.arbitrary ι}],
  simp only [h, finset.sup_singleton],
end

lemma is_bounded_sup {p : ι → seminorm 𝕜 E} {q : ι' → seminorm 𝕜 F}
  {f : E →ₗ[𝕜] F} (hf : is_bounded p q f) (s' : finset ι') :
  ∃ (C : ℝ≥0) (s : finset ι), 0 < C ∧ (s'.sup q).comp f ≤ C • (s.sup p) :=
begin
  classical,
  by_cases hs' : ¬s'.nonempty,
  { refine ⟨1, ∅, zero_lt_one, _⟩,
    rw [finset.not_nonempty_iff_eq_empty.mp hs', finset.sup_empty, seminorm.bot_eq_zero, zero_comp],
    exact seminorm.nonneg _ },
  rw not_not at hs',
  choose fₛ fC hf using hf,
  use [s'.card • s'.sup fC, finset.bUnion s' fₛ],
  split,
  { refine nsmul_pos _ (ne_of_gt (finset.nonempty.card_pos hs')),
    cases finset.nonempty.bex hs' with j hj,
    exact lt_of_lt_of_le (zero_lt_iff.mpr (and.elim_left (hf j))) (finset.le_sup hj) },
  have hs : ∀ i : ι', i ∈ s' → (q i).comp f ≤ s'.sup fC • ((finset.bUnion s' fₛ).sup p) :=
  begin
    intros i hi,
    refine le_trans (and.elim_right (hf i)) (smul_le_smul _ (finset.le_sup hi)),
    exact finset.sup_mono (finset.subset_bUnion_of_mem fₛ hi),
  end,
  refine le_trans (comp_mono f (finset_sup_le_sum q s')) _,
  simp_rw [←pullback_apply, add_monoid_hom.map_sum, pullback_apply],
  refine le_trans (finset.sum_le_sum hs) _,
  rw [finset.sum_const, smul_assoc],
  exact le_rfl,
end

end seminorm

end bounded

section topology

variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [nonempty ι]

/-- The proposition that the topology of `E` is induced by a family of seminorms `p`. -/
class with_seminorms (p : seminorm_family 𝕜 E ι) [t : topological_space E] : Prop :=
(topology_eq_with_seminorms : t = p.module_filter_basis.topology)

lemma seminorm_family.with_seminorms_eq (p : seminorm_family 𝕜 E ι) [t : topological_space E]
  [with_seminorms p] : t = p.module_filter_basis.topology :=
with_seminorms.topology_eq_with_seminorms

variables [topological_space E]
variables (p : seminorm_family 𝕜 E ι) [with_seminorms p]

lemma seminorm_family.has_basis : (𝓝 (0 : E)).has_basis
  (λ (s : set E), s ∈ p.basis_sets) id :=
begin
  rw (congr_fun (congr_arg (@nhds E) p.with_seminorms_eq) 0),
  exact add_group_filter_basis.nhds_zero_has_basis _,
end
end topology

section topological_add_group

variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E]
variables [topological_space E] [topological_add_group E]
variables [nonempty ι]

lemma seminorm_family.with_seminorms_of_nhds (p : seminorm_family 𝕜 E ι)
  (h : 𝓝 (0 : E) = p.module_filter_basis.to_filter_basis.filter) :
  with_seminorms p :=
begin
  refine ⟨topological_add_group.ext (by apply_instance)
    (p.add_group_filter_basis.is_topological_add_group) _⟩,
  rw add_group_filter_basis.nhds_zero_eq,
  exact h,
end

lemma seminorm_family.with_seminorms_of_has_basis (p : seminorm_family 𝕜 E ι)
  (h : (𝓝 (0 : E)).has_basis (λ (s : set E), s ∈ p.basis_sets) id) :
  with_seminorms p :=
p.with_seminorms_of_nhds $ filter.has_basis.eq_of_same_basis h
  p.add_group_filter_basis.to_filter_basis.has_basis

lemma seminorm_family.with_seminorms_iff_nhds_eq_infi (p : seminorm_family 𝕜 E ι) :
  with_seminorms p ↔ (𝓝 0 : filter E) = ⨅ i, (𝓝 0).comap (p i) :=
begin
  rw ← p.filter_eq_infi,
  refine ⟨λ h, _, p.with_seminorms_of_nhds⟩,
  rw h.topology_eq_with_seminorms,
  exact add_group_filter_basis.nhds_zero_eq _,
end

end topological_add_group

section normed_space

/-- The topology of a `normed_space 𝕜 E` is induced by the seminorm `norm_seminorm 𝕜 E`. -/
instance norm_with_seminorms (𝕜 E) [normed_field 𝕜] [semi_normed_group E] [normed_space 𝕜 E] :
  with_seminorms (λ (_ : fin 1), norm_seminorm 𝕜 E) :=
begin
  let p : seminorm_family 𝕜 E (fin 1) := λ _, norm_seminorm 𝕜 E,
  refine ⟨topological_add_group.ext normed_top_group
    (p.add_group_filter_basis.is_topological_add_group) _⟩,
  refine filter.has_basis.eq_of_same_basis metric.nhds_basis_ball _,
  rw ←ball_norm_seminorm 𝕜 E,
  refine filter.has_basis.to_has_basis p.add_group_filter_basis.nhds_zero_has_basis _
    (λ r hr, ⟨(norm_seminorm 𝕜 E).ball 0 r, p.basis_sets_singleton_mem 0 hr, rfl.subset⟩),
  rintros U (hU : U ∈ p.basis_sets),
  rcases p.basis_sets_iff.mp hU with ⟨s, r, hr, hU⟩,
  use [r, hr],
  rw [hU, id.def],
  by_cases h : s.nonempty,
  { rw finset.sup_const h },
  rw [finset.not_nonempty_iff_eq_empty.mp h, finset.sup_empty, ball_bot _ hr],
  exact set.subset_univ _,
end

end normed_space

section nondiscrete_normed_field

variables [nondiscrete_normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [nonempty ι]
variables (p : seminorm_family 𝕜 E ι)
variables [topological_space E] [with_seminorms p]

lemma bornology.is_vonN_bounded_iff_finset_seminorm_bounded {s : set E} :
  bornology.is_vonN_bounded 𝕜 s ↔ ∀ I : finset ι, ∃ r (hr : 0 < r), ∀ (x ∈ s), I.sup p x < r :=
begin
  rw (p.has_basis).is_vonN_bounded_basis_iff,
  split,
  { intros h I,
    simp only [id.def] at h,
    specialize h ((I.sup p).ball 0 1) (p.basis_sets_mem I zero_lt_one),
    rcases h with ⟨r, hr, h⟩,
    cases normed_field.exists_lt_norm 𝕜 r with a ha,
    specialize h a (le_of_lt ha),
    rw [seminorm.smul_ball_zero (lt_trans hr ha), mul_one] at h,
    refine ⟨∥a∥, lt_trans hr ha, _⟩,
    intros x hx,
    specialize h hx,
    exact (finset.sup I p).mem_ball_zero.mp h },
  intros h s' hs',
  rcases p.basis_sets_iff.mp hs' with ⟨I, r, hr, hs'⟩,
  rw [id.def, hs'],
  rcases h I with ⟨r', hr', h'⟩,
  simp_rw ←(I.sup p).mem_ball_zero at h',
  refine absorbs.mono_right _ h',
  exact (finset.sup I p).ball_zero_absorbs_ball_zero hr,
end

lemma bornology.is_vonN_bounded_iff_seminorm_bounded {s : set E} :
  bornology.is_vonN_bounded 𝕜 s ↔ ∀ i : ι, ∃ r (hr : 0 < r), ∀ (x ∈ s), p i x < r :=
begin
  rw bornology.is_vonN_bounded_iff_finset_seminorm_bounded p,
  split,
  { intros hI i,
    convert hI {i},
    rw [finset.sup_singleton] },
  intros hi I,
  by_cases hI : I.nonempty,
  { choose r hr h using hi,
    have h' : 0 < I.sup' hI r :=
    by { rcases hI.bex with ⟨i, hi⟩, exact lt_of_lt_of_le (hr i) (finset.le_sup' r hi) },
    refine ⟨I.sup' hI r, h', λ x hx, finset_sup_apply_lt h' (λ i hi, _)⟩,
    refine lt_of_lt_of_le (h i x hx) _,
    simp only [finset.le_sup'_iff, exists_prop],
    exact ⟨i, hi, (eq.refl _).le⟩ },
  simp only [finset.not_nonempty_iff_eq_empty.mp hI, finset.sup_empty, coe_bot, pi.zero_apply,
    exists_prop],
  exact ⟨1, zero_lt_one, λ _ _, zero_lt_one⟩,
end

end nondiscrete_normed_field
section continuous_bounded

namespace seminorm

variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [add_comm_group F] [module 𝕜 F]
variables [nonempty ι] [nonempty ι']

lemma continuous_from_bounded (p : seminorm_family 𝕜 E ι) (q : seminorm_family 𝕜 F ι')
  [uniform_space E] [uniform_add_group E] [with_seminorms p]
  [uniform_space F] [uniform_add_group F] [with_seminorms q]
  (f : E →ₗ[𝕜] F) (hf : seminorm.is_bounded p q f) : continuous f :=
begin
  refine continuous_of_continuous_at_zero f _,
  rw [continuous_at_def, f.map_zero, p.with_seminorms_eq],
  intros U hU,
  rw [q.with_seminorms_eq, add_group_filter_basis.nhds_zero_eq, filter_basis.mem_filter_iff] at hU,
  rcases hU with ⟨V, hV : V ∈ q.basis_sets, hU⟩,
  rcases q.basis_sets_iff.mp hV with ⟨s₂, r, hr, hV⟩,
  rw hV at hU,
  rw [p.add_group_filter_basis.nhds_zero_eq, filter_basis.mem_filter_iff],
  rcases (seminorm.is_bounded_sup hf s₂) with ⟨C, s₁, hC, hf⟩,
  refine ⟨(s₁.sup p).ball 0 (r/C), p.basis_sets_mem _ (div_pos hr (nnreal.coe_pos.mpr hC)), _⟩,
  refine subset.trans _ (preimage_mono hU),
  simp_rw [←linear_map.map_zero f, ←ball_comp],
  refine subset.trans _ (ball_antitone hf),
  rw ball_smul (s₁.sup p) hC,
end

lemma cont_with_seminorms_normed_space (F) [semi_normed_group F] [normed_space 𝕜 F]
  [uniform_space E] [uniform_add_group E]
  (p : ι → seminorm 𝕜 E) [with_seminorms p] (f : E →ₗ[𝕜] F)
  (hf : ∃ (s : finset ι) C : ℝ≥0, C ≠ 0 ∧ (norm_seminorm 𝕜 F).comp f ≤ C • s.sup p) :
  continuous f :=
begin
  rw ←seminorm.is_bounded_const (fin 1) at hf,
  exact continuous_from_bounded p (λ _ : fin 1, norm_seminorm 𝕜 F) f hf,
end

lemma cont_normed_space_to_with_seminorms (E) [semi_normed_group E] [normed_space 𝕜 E]
  [uniform_space F] [uniform_add_group F]
  (q : ι → seminorm 𝕜 F) [with_seminorms q] (f : E →ₗ[𝕜] F)
  (hf : ∀ i : ι, ∃ C : ℝ≥0, C ≠ 0 ∧ (q i).comp f ≤ C • (norm_seminorm 𝕜 E)) : continuous f :=
begin
  rw ←seminorm.const_is_bounded (fin 1) at hf,
  exact continuous_from_bounded (λ _ : fin 1, norm_seminorm 𝕜 E) q f hf,
end

end seminorm

end continuous_bounded

section locally_convex_space

open locally_convex_space

variables [nonempty ι] [normed_field 𝕜] [normed_space ℝ 𝕜]
  [add_comm_group E] [module 𝕜 E] [module ℝ E] [is_scalar_tower ℝ 𝕜 E] [topological_space E]
  [topological_add_group E]

lemma seminorm_family.to_locally_convex_space (p : seminorm_family 𝕜 E ι) [with_seminorms p] :
  locally_convex_space ℝ E :=
begin
  apply of_basis_zero ℝ E id (λ s, s ∈ p.basis_sets),
  { rw [p.with_seminorms_eq, add_group_filter_basis.nhds_eq _, add_group_filter_basis.N_zero],
    exact filter_basis.has_basis _ },
  { intros s hs,
    change s ∈ set.Union _ at hs,
    simp_rw [set.mem_Union, set.mem_singleton_iff] at hs,
    rcases hs with ⟨I, r, hr, rfl⟩,
    exact convex_ball _ _ _ }
end

end locally_convex_space

section normed_space

variables (𝕜) [normed_field 𝕜] [normed_space ℝ 𝕜] [semi_normed_group E]

/-- Not an instance since `𝕜` can't be inferred. See `normed_space.to_locally_convex_space` for a
slightly weaker instance version. -/
lemma normed_space.to_locally_convex_space' [normed_space 𝕜 E] [module ℝ E]
  [is_scalar_tower ℝ 𝕜 E] : locally_convex_space ℝ E :=
seminorm_family.to_locally_convex_space (λ _ : fin 1, norm_seminorm 𝕜 E)

/-- See `normed_space.to_locally_convex_space'` for a slightly stronger version which is not an
instance. -/
instance normed_space.to_locally_convex_space [normed_space ℝ E] :
  locally_convex_space ℝ E :=
normed_space.to_locally_convex_space' ℝ

end normed_space

section topological_constructions

variables [normed_field 𝕜] [add_comm_group F] [module 𝕜 F] [add_comm_group E] [module 𝕜 E]

/-- The family of seminorms obtained by composing each seminorm by a linear map. -/
def seminorm_family.comp (q : seminorm_family 𝕜 F ι) (f : E →ₗ[𝕜] F) :
  seminorm_family 𝕜 E ι :=
λ i, (q i).comp f

lemma seminorm_family.comp_apply (q : seminorm_family 𝕜 F ι) (i : ι) (f : E →ₗ[𝕜] F) :
  q.comp f i = (q i).comp f :=
rfl

lemma seminorm_family.finset_sup_comp (q : seminorm_family 𝕜 F ι) (s : finset ι)
  (f : E →ₗ[𝕜] F) : (s.sup q).comp f = s.sup (q.comp f) :=
begin
  ext x,
  rw [seminorm.comp_apply, seminorm.finset_sup_apply, seminorm.finset_sup_apply],
  refl
end

variables [topological_space F] [topological_add_group F]

lemma linear_map.with_seminorms_induced [hι : nonempty ι] {q : seminorm_family 𝕜 F ι}
  [hq : with_seminorms q] (f : E →ₗ[𝕜] F) :
  @with_seminorms 𝕜 E ι _ _ _ _ (q.comp f) (induced f infer_instance) :=
begin
  letI : topological_space E := induced f infer_instance,
  letI : topological_add_group E := topological_add_group_induced f,
  rw [(q.comp f).with_seminorms_iff_nhds_eq_infi, nhds_induced, map_zero,
      q.with_seminorms_iff_nhds_eq_infi.mp hq, filter.comap_infi],
  refine infi_congr (λ i, _),
  exact filter.comap_comap
end

lemma inducing.with_seminorms [hι : nonempty ι] {q : seminorm_family 𝕜 F ι}
  [hq : with_seminorms q] [topological_space E] {f : E →ₗ[𝕜] F} (hf : inducing f) :
  with_seminorms (q.comp f) :=
begin
  rw hf.induced,
  exact f.with_seminorms_induced
end

end topological_constructions


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import topology.metric_space.basic
import topology.algebra.order.archimedean
import topology.instances.int
import topology.instances.nat
import topology.instances.real
/-!
# Topology on the ratonal numbers

The structure of a metric space on `ℚ` is introduced in this file, induced from `ℝ`.
-/
noncomputable theory
open metric set filter

namespace rat

instance : metric_space ℚ :=
metric_space.induced coe rat.cast_injective real.metric_space

theorem dist_eq (x y : ℚ) : dist x y = |x - y| := rfl

@[norm_cast, simp] lemma dist_cast (x y : ℚ) : dist (x : ℝ) y = dist x y := rfl

theorem uniform_continuous_coe_real : uniform_continuous (coe : ℚ → ℝ) :=
uniform_continuous_comap

theorem uniform_embedding_coe_real : uniform_embedding (coe : ℚ → ℝ) :=
uniform_embedding_comap rat.cast_injective

theorem dense_embedding_coe_real : dense_embedding (coe : ℚ → ℝ) :=
uniform_embedding_coe_real.dense_embedding rat.dense_range_cast

theorem embedding_coe_real : embedding (coe : ℚ → ℝ) := dense_embedding_coe_real.to_embedding

theorem continuous_coe_real : continuous (coe : ℚ → ℝ) := uniform_continuous_coe_real.continuous

end rat

@[norm_cast, simp] theorem nat.dist_cast_rat (x y : ℕ) : dist (x : ℚ) y = dist x y :=
by rw [← nat.dist_cast_real, ← rat.dist_cast]; congr' 1; norm_cast

lemma nat.uniform_embedding_coe_rat : uniform_embedding (coe : ℕ → ℚ) :=
uniform_embedding_bot_of_pairwise_le_dist zero_lt_one $ by simpa using nat.pairwise_one_le_dist

lemma nat.closed_embedding_coe_rat : closed_embedding (coe : ℕ → ℚ) :=
closed_embedding_of_pairwise_le_dist zero_lt_one $ by simpa using nat.pairwise_one_le_dist

@[norm_cast, simp] theorem int.dist_cast_rat (x y : ℤ) : dist (x : ℚ) y = dist x y :=
by rw [← int.dist_cast_real, ← rat.dist_cast]; congr' 1; norm_cast

lemma int.uniform_embedding_coe_rat : uniform_embedding (coe : ℤ → ℚ) :=
uniform_embedding_bot_of_pairwise_le_dist zero_lt_one $ by simpa using int.pairwise_one_le_dist

lemma int.closed_embedding_coe_rat : closed_embedding (coe : ℤ → ℚ) :=
closed_embedding_of_pairwise_le_dist zero_lt_one $ by simpa using int.pairwise_one_le_dist

instance : noncompact_space ℚ := int.closed_embedding_coe_rat.noncompact_space

-- TODO(Mario): Find a way to use rat_add_continuous_lemma
theorem rat.uniform_continuous_add : uniform_continuous (λp : ℚ × ℚ, p.1 + p.2) :=
rat.uniform_embedding_coe_real.to_uniform_inducing.uniform_continuous_iff.2 $
  by simp only [(∘), rat.cast_add]; exact real.uniform_continuous_add.comp
    (rat.uniform_continuous_coe_real.prod_map rat.uniform_continuous_coe_real)

theorem rat.uniform_continuous_neg : uniform_continuous (@has_neg.neg ℚ _) :=
metric.uniform_continuous_iff.2 $ λ ε ε0, ⟨_, ε0, λ a b h,
  by rw dist_comm at h; simpa [rat.dist_eq] using h⟩

instance : uniform_add_group ℚ :=
uniform_add_group.mk' rat.uniform_continuous_add rat.uniform_continuous_neg

instance : topological_add_group ℚ := by apply_instance

instance : order_topology ℚ :=
induced_order_topology _ (λ x y, rat.cast_lt) (@exists_rat_btwn _ _ _)

lemma rat.uniform_continuous_abs : uniform_continuous (abs : ℚ → ℚ) :=
metric.uniform_continuous_iff.2 $ λ ε ε0,
  ⟨ε, ε0, λ a b h, lt_of_le_of_lt
    (by simpa [rat.dist_eq] using abs_abs_sub_abs_le_abs_sub _ _) h⟩

lemma rat.continuous_mul : continuous (λp : ℚ × ℚ, p.1 * p.2) :=
rat.embedding_coe_real.continuous_iff.2 $ by simp [(∘)]; exact
real.continuous_mul.comp ((rat.continuous_coe_real.prod_map rat.continuous_coe_real))

instance : topological_ring ℚ :=
{ continuous_mul := rat.continuous_mul, ..rat.topological_add_group }

lemma rat.totally_bounded_Icc (a b : ℚ) : totally_bounded (Icc a b) :=
begin
  have := totally_bounded_preimage rat.uniform_embedding_coe_real (totally_bounded_Icc a b),
  rwa (set.ext (λ q, _) : Icc _ _ = _), simp
end


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/

import data.fintype.order
import field_theory.fixed
import normed_space

/-!
# alg_norm_of_auto and alg_norm_of_galois

In the section `supr` we prove some lemmas about indexed supremums, which will be PRd to the
appropriate files in mathlib.

For the rest of the file, we let `K` be a nonarchimedean normed field and `L/K` be a finite
algebraic extension. In the comments, `‖ ⬝ ‖` denotes any power-multiplicative algebra norm on `L`
extending the norm  on `K`.

## Main Definitions

* `alg_norm_of_auto` : given `σ : L ≃ₐ[K] L`, the function `L → ℝ` sending `x : L` to `‖ σ x ‖` is
  an algebra norm on `K`.
* `alg_norm_of_galois` : the function `L → ℝ` sending `x : L` to the maximum of `‖ σ x ‖` over
  all `σ : L ≃ₐ[K] L` is an algebra norm on `L`.

## Main Results
* `alg_norm_of_auto_is_pow_mul` : `alg_norm_of_auto` is power-multiplicative.
* `alg_norm_of_auto_is_nonarchimedean` : `alg_norm_of_auto` is nonarchimedean.
* `alg_norm_of_auto_extends` : `alg_norm_of_auto` extends the norm on `K`.
* `alg_norm_of_galois_is_pow_mul` : `alg_norm_of_galois` is power-multiplicative.
* `alg_norm_of_galois_is_nonarchimedean` : `alg_norm_of_galois` is nonarchimedean.
* `alg_norm_of_galois_extends` : `alg_norm_of_galois` extends the norm on `K`.

## References
* [S. Bosch, U. Güntzer, R. Remmert, *Non-Archimedean Analysis*][bosch-guntzer-remmert]

## Tags

alg_norm_of_auto, alg_norm_of_galois, norm, nonarchimedean
-/

open_locale nnreal

noncomputable theory

/-! ## supr
In this section we prove some lemmas about `supr`, most of them for real-valued functions. -/
section supr

/-- If the function `f : ι → α` is bounded above and `a < f i` for some `i : ι`, then `a < supr f` -/
lemma lt_csupr_of_lt {α : Type*} {ι : Sort*} [conditionally_complete_lattice α] {a : α} {f : ι → α}
  (H : bdd_above (set.range f)) (i : ι) (h : a < f i) : a < supr f :=
lt_of_lt_of_le h (le_csupr H i)

lemma csupr_univ {α β : Type*} [fintype β] [conditionally_complete_lattice α] {f : β → α} :
  (⨆ (x : β) (H : x ∈ (finset.univ : finset β)), f x) = ⨆ (x : β), f x :=
by simp only [finset.mem_univ, csupr_pos]

lemma csupr₂_le {ι : Sort*} [nonempty ι] {κ : ι → Prop} {α : Type*}
  [conditionally_complete_linear_order_bot α] {f : Π i, κ i →  α} {a : α} (h : ∀ i j, f i j ≤ a) :
  (⨆ i j, f i j) ≤ a :=
begin
  apply csupr_le,
  intro x,
  by_cases hx : κ x,
  { haveI : nonempty (κ x) := ⟨hx⟩,
    exact csupr_le (λ hx',  h _ _),  },
  {  simp only [(iff_false _).mpr hx, csupr_false, bot_le], },
end

lemma le_csupr₂_of_le' {ι : Sort*} [finite ι] {κ : ι → Prop} {α : Type*}
  [conditionally_complete_linear_order_bot α] {f : Π i, κ i → α} {a : α} (i : ι) (j : κ i)
  (h : a ≤ f i j) : a ≤ ⨆ i j, f i j :=
begin
  apply le_csupr_of_le _ i,
  { apply le_csupr_of_le (set.finite.bdd_above (set.finite_range (λ (j : κ i), f i j))) j h, },
  { exact set.finite.bdd_above (set.finite_range _) },
end

lemma le_csupr₂_of_le {ι : Sort*} {κ : ι → Prop} {α : Type*}
  [conditionally_complete_linear_order_bot α] {f : Π i, κ i → α}
  (h_fin : (set.range (λ (i : ι), ⨆ (j : κ i), f i j)).finite)
  {a : α} (i : ι) (j : κ i)
  (h : a ≤ f i j) : a ≤ ⨆ i j, f i j :=
begin
  apply le_csupr_of_le _ i,
  { apply le_csupr_of_le (set.finite.bdd_above (set.finite_range (λ (j : κ i), f i j))) j h, },
  { apply set.finite.bdd_above h_fin }
end

theorem finset.sup_eq_csupr {α  β : Type*} [nonempty α] [conditionally_complete_linear_order_bot β]
  (s : finset α) (f : α → β) : s.sup f = ⨆ (a : α) (H : a ∈ s), f a :=
begin
  apply le_antisymm,
  { apply finset.sup_le,
    intros a ha,
    apply le_csupr₂_of_le _ a ha (le_refl _),
    have hrange: set.range (λ (a : α), ⨆ (H : a ∈ s), f a) ⊆ set.range (λ (a : s), f a) ∪ {⊥},
    { rintros y ⟨x, hxy⟩,
      simp only [set.mem_range, bot_eq_zero', set.union_singleton, set.mem_insert_iff] at y ⊢,
      by_cases hx : x ∈ s,
      { right, simp only [hx, csupr_pos] at hxy, exact ⟨⟨x, hx⟩, hxy⟩, },
      { left, simp only [hx, csupr_false] at hxy, exact hxy.symm }},
    exact set.finite.subset (set.range (λ (a : ↥s), f ↑a) ∪ {⊥}).to_finite hrange,  },
  { exact csupr₂_le (λ x, finset.le_sup) }
end

/-- Given `f : ι → ℝ≥0` and `n : ℕ`, we have `(supr f)^n = supr (f^n)`. -/
lemma nnreal.supr_pow {ι : Type*} [nonempty ι] [finite ι] (f : ι → ℝ≥0) (n : ℕ) :
  (⨆ (i : ι), f i)^n = ⨆ (i : ι), (f i)^n :=
begin
  casesI nonempty_fintype ι,
  induction n with n hn,
  { simp only [pow_zero, csupr_const], },
  { rw [pow_succ, hn],
    apply le_antisymm,
    { apply nnreal.supr_mul_supr_le,
      intros i j,
      by_cases hij : f i < f j,
      { have hj : f i * f j ^ n ≤ f j ^ n.succ,
        { rw pow_succ, apply mul_le_mul' (le_of_lt hij) (le_refl _) },
        exact le_trans hj (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) j
          (le_refl _)), },
      { have hi : f i * f j ^ n ≤ f i ^ n.succ,
        { rw pow_succ, exact mul_le_mul' (le_refl _) (pow_le_pow_of_le_left' (not_lt.mp hij) n) },
        exact le_trans hi (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) i
          (le_refl _)), }},
    { haveI : nonempty (finset.univ : finset ι),
      { exact finset.nonempty_coe_sort.mpr finset.univ_nonempty },
      simp only [← csupr_univ, ← finset.sup_eq_csupr, pow_succ],
      apply finset.sup_mul_le_mul_sup_of_nonneg;
      rintros i -; exact zero_le _ }},
end

/-- The supr of a non-negative function `f : ι → ℝ` is non-negative. -/
lemma real.supr_nonneg {ι : Type*} [nonempty ι] {f : ι → ℝ} (hf_nn : ∀ i, 0 ≤ f i) :
  0 ≤ supr f :=
begin
  by_cases hf : bdd_above (set.range f),
  { set i : ι := nonempty.some (by apply_instance),
    exact le_csupr_of_le hf i (hf_nn i), },
  { simp only [supr, Sup],
    rw dif_neg (not_and_of_not_right _ hf) }
end

/-- If `f : ι → ℝ` and `g : ι → ℝ` are non-negative and `∀ i j, f i * g j ≤ a`, then
 `supr f * supr g ≤ a`. -/
lemma real.supr_mul_supr_le {ι : Type*} [nonempty ι] {a : ℝ} {f g : ι → ℝ} (hf_nn : ∀ i, 0 ≤ f i)
  (hg_nn : ∀ i, 0 ≤ g i) (H : ∀ i j, f i * g j ≤ a) : supr f * supr g ≤ a :=
begin
  rw real.supr_mul_of_nonneg (real.supr_nonneg hg_nn),
  apply csupr_le,
  intro i,
  rw real.mul_supr_of_nonneg (hf_nn _),
  exact csupr_le (λ j, H i j),
end

/-- If `f : ι → ℝ` and `g : ι → ℝ` are non-negative, then `supr (f*g) ≤ supr f * supr g`. -/
lemma real.supr_mul_le_mul_supr_of_nonneg {ι : Type*} [nonempty ι] [finite ι] {f g : ι → ℝ}
  (hf_nn : ∀ i, 0 ≤ f i) (hg_nn : ∀ i, 0 ≤ g i) : (⨆ (i : ι), f i * g i) ≤ supr f * supr g :=
begin
  casesI nonempty_fintype ι,
  have hf : bdd_above (set.range f) := fintype.bdd_above_range f,
  have hg : bdd_above (set.range g) := fintype.bdd_above_range g,
  exact csupr_le (λ x, mul_le_mul (le_csupr hf x) (le_csupr hg x) (hg_nn x)
      (real.supr_nonneg hf_nn)),
end

/-- Given a non-negative `f : ι → ℝ` and `n : ℕ`, we have `(supr f)^n = supr (f^n)`. -/
lemma real.supr_pow {ι : Type*} [nonempty ι] [finite ι] {f : ι → ℝ} (hf_nn : ∀ i, 0 ≤ f i)
  (n : ℕ) : (⨆ (i : ι), f i)^n = ⨆ (i : ι), (f i)^n :=
begin
  casesI nonempty_fintype ι,
  induction n with n hn,
  { simp only [pow_zero, csupr_const], },
  { rw [pow_succ, hn],
    apply le_antisymm,
    { refine real.supr_mul_supr_le hf_nn (λ x, pow_nonneg (hf_nn x) n) _,
      intros i j,
      by_cases hij : f i < f j,
      { have hj : f i * f j ^ n ≤ f j ^ n.succ,
        { rw pow_succ,
          exact mul_le_mul (le_of_lt hij) (le_refl _) (pow_nonneg (hf_nn _) _) (hf_nn _) },
        exact le_trans hj (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) j
          (le_refl _)), },
      { have hi : f i * f j ^ n ≤ f i ^ n.succ,
        { rw pow_succ,
          exact mul_le_mul (le_refl _) (pow_le_pow_of_le_left (hf_nn _) (not_lt.mp hij) _)
            (pow_nonneg (hf_nn _) _) (hf_nn _) },
        exact le_trans hi (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) i
          (le_refl _)), }},
    { simp_rw [pow_succ],
      exact real.supr_mul_le_mul_supr_of_nonneg hf_nn (λ x, pow_nonneg (hf_nn x) n) }},
end

end supr

variables {K : Type*} [normed_field K] {L : Type*} [field L] [algebra K L]
  (h_alg : algebra.is_algebraic K L) (h_fin : finite_dimensional K L)

section alg_norm_of_auto

/-- Given a normed field `K`, a finite algebraic extension `L/K` and `σ : L ≃ₐ[K] L`, the function
`L → ℝ` sending `x : L` to `‖ σ x ‖`, where `‖ ⬝ ‖` is any power-multiplicative algebra norm on `L`
extending the norm on `K`, is an algebra norm on `K`. -/
def alg_norm_of_auto (hna : is_nonarchimedean (norm : K → ℝ)) (σ : L ≃ₐ[K] L) :
  algebra_norm K L :=
{ to_fun    := λ x, classical.some (finite_extension_pow_mul_seminorm h_fin hna) (σ x),
  map_zero' := by simp only [map_zero],
  add_le'   := λ x y, by simp only [map_add σ, map_add_le_add],
  neg'      := λ x, by simp only [map_neg σ, map_neg_eq_map],
  mul_le'   := λ x y, by simp only [map_mul σ, map_mul_le_mul],
  smul'     := λ x y, by simp only [map_smul σ, map_smul_eq_mul],
  eq_zero_of_map_eq_zero' := λ x hx,
    (add_equiv_class.map_eq_zero_iff _).mp (eq_zero_of_map_eq_zero _ hx), }

lemma alg_norm_of_auto_apply (σ : L ≃ₐ[K] L) (hna : is_nonarchimedean (norm : K → ℝ)) (x : L) :
  alg_norm_of_auto h_fin hna σ x =
  classical.some (finite_extension_pow_mul_seminorm h_fin hna) (σ x) := rfl

/-- The algebra norm `alg_norm_of_auto` is power-multiplicative. -/
lemma alg_norm_of_auto_is_pow_mul (σ : L ≃ₐ[K] L) (hna : is_nonarchimedean (norm : K → ℝ)) :
  is_pow_mul (alg_norm_of_auto h_fin hna σ) :=
begin
  intros x n hn,
  simp only [alg_norm_of_auto_apply, map_pow σ x n],
  exact (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).1 _ hn,
end

/-- The algebra norm `alg_norm_of_auto` is nonarchimedean. -/
lemma alg_norm_of_auto_is_nonarchimedean (σ : L ≃ₐ[K] L)
  (hna : is_nonarchimedean (norm : K → ℝ)) :
  is_nonarchimedean (alg_norm_of_auto h_fin hna σ):=
begin
  intros x y,
  simp only [alg_norm_of_auto_apply, map_add σ],
  exact (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).2.2 _ _,
end

/-- The algebra norm `alg_norm_of_auto` extends the norm on `K`. -/
lemma alg_norm_of_auto_extends (σ : L ≃ₐ[K] L) (hna : is_nonarchimedean (norm : K → ℝ)) :
  function_extends (norm : K → ℝ) (alg_norm_of_auto h_fin hna σ) :=
begin
  intro r, simp only [alg_norm_of_auto_apply, alg_equiv.commutes],
  exact (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).2.1 _,
end

end alg_norm_of_auto

section alg_norm_of_galois

/-- The function `L → ℝ` sending `x : L` to the maximum of `alg_norm_of_auto h_fin hna σ` over
  all `σ : L ≃ₐ[K] L` is an algebra norm on `L`. -/
def alg_norm_of_galois (hna : is_nonarchimedean (norm : K → ℝ)) :
  algebra_norm K L :=
{ to_fun    := λ x, (supr (λ (σ : L ≃ₐ[K] L), alg_norm_of_auto h_fin hna σ x)),
  map_zero' := by simp only [map_zero,  csupr_const],
  add_le'   := λ x y, csupr_le (λ σ, le_trans (map_add_le_add (alg_norm_of_auto h_fin hna σ) x y)
    (add_le_add (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _))
      (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _)))),
  neg' := λ x, by simp only [map_neg_eq_map],
  mul_le'     := λ x y, csupr_le $ λ σ, le_trans (map_mul_le_mul (alg_norm_of_auto h_fin hna σ) x y)
     (mul_le_mul (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _))
        (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _)) (map_nonneg _ _)
        (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (map_nonneg _ _))),
  eq_zero_of_map_eq_zero' := λ x,
  begin
    contrapose!,
    exact λ hx, ne_of_gt (lt_csupr_of_lt  (set.finite.bdd_above (set.range (λ (σ : L ≃ₐ[K] L),
      alg_norm_of_auto h_fin hna σ x)).to_finite) (alg_equiv.refl) (map_pos_of_ne_zero _ hx)),
  end,
  smul'    := λ r x, by simp only [algebra_norm_class.map_smul_eq_mul,
    normed_ring.to_ring_norm_apply, real.mul_supr_of_nonneg (norm_nonneg _)] }

@[simp] lemma alg_norm_of_galois_apply (hna : is_nonarchimedean (norm : K → ℝ)) (x : L) :
  alg_norm_of_galois h_fin hna x = (supr (λ (σ : L ≃ₐ[K] L), alg_norm_of_auto h_fin hna σ x)) :=
rfl

/-- The algebra norm `alg_norm_of_galois` is power-multiplicative. -/
lemma alg_norm_of_galois_is_pow_mul (hna : is_nonarchimedean (norm : K → ℝ)) :
  is_pow_mul (alg_norm_of_galois h_fin hna) :=
begin
  intros x n hn,
  simp only [alg_norm_of_galois_apply],
  rw real.supr_pow,
  exact supr_congr (λ σ, alg_norm_of_auto_is_pow_mul h_fin σ hna _ hn),
  { exact λ σ, map_nonneg (alg_norm_of_auto h_fin hna σ) x }
end

/-- The algebra norm `alg_norm_of_galois` is nonarchimedean. -/
lemma alg_norm_of_galois_is_nonarchimedean (hna : is_nonarchimedean (norm : K → ℝ)) :
  is_nonarchimedean (alg_norm_of_galois h_fin hna)  :=
λ x y, csupr_le (λ σ, le_trans ((alg_norm_of_auto_is_nonarchimedean h_fin σ hna) x y)
  (max_le_max (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _))
    (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _))))

/-- The algebra norm `alg_norm_of_galois` extends the norm on `K`. -/
lemma alg_norm_of_galois_extends (hna : is_nonarchimedean (norm : K → ℝ)) :
  function_extends (norm : K → ℝ) (alg_norm_of_galois h_fin hna) :=
λ r, begin
  rw [alg_norm_of_galois, ← algebra_norm.to_fun_eq_coe],
  simp only [algebra_norm.to_fun_eq_coe, alg_norm_of_auto_extends h_fin _ hna r, csupr_const],
end

end alg_norm_of_galois


/-
Copyright (c) 2020 Ruben Van de Velde, Stanislas Polu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ruben Van de Velde, Stanislas Polu
-/

import data.real.basic
import analysis.normed_space.basic

/-!
# IMO 1972 Q5

Problem: `f` and `g` are real-valued functions defined on the real line. For all `x` and `y`,
`f(x + y) + f(x - y) = 2f(x)g(y)`. `f` is not identically zero and `|f(x)| ≤ 1` for all `x`.
Prove that `|g(x)| ≤ 1` for all `x`.
-/

/--
This proof begins by introducing the supremum of `f`, `k ≤ 1` as well as `k' = k / ‖g y‖`. We then
suppose that the conclusion does not hold (`hneg`) and show that `k ≤ k'` (by
`2 * (‖f x‖ * ‖g y‖) ≤ 2 * k` obtained from the main hypothesis `hf1`) and that `k' < k` (obtained
from `hneg` directly), finally raising a contradiction with `k' < k'`.

(Authored by Stanislas Polu inspired by Ruben Van de Velde).
-/
example (f g : ℝ → ℝ)
  (hf1 : ∀ x, ∀ y, (f(x+y) + f(x-y)) = 2 * f(x) * g(y))
  (hf2 : ∀ y, ‖f(y)‖ ≤ 1)
  (hf3 : ∃ x, f(x) ≠ 0)
  (y : ℝ) :
  ‖g(y)‖ ≤ 1 :=
begin
  set S := set.range (λ x, ‖f x‖),
  -- Introduce `k`, the supremum of `f`.
  let k : ℝ := Sup (S),

  -- Show that `‖f x‖ ≤ k`.
  have hk₁ : ∀ x, ‖f x‖ ≤ k,
  { have h : bdd_above S, from ⟨1, set.forall_range_iff.mpr hf2⟩,
    intro x,
    exact le_cSup h (set.mem_range_self x), },
  -- Show that `2 * (‖f x‖ * ‖g y‖) ≤ 2 * k`.
  have hk₂ : ∀ x, 2 * (‖f x‖ * ‖g y‖) ≤ 2 * k,
  { intro x,
    calc 2 * (‖f x‖ * ‖g y‖)
        = ‖2 * f x * g y‖ : by simp [abs_mul, mul_assoc]
    ... = ‖f (x + y) + f (x - y)‖ : by rw hf1
    ... ≤ ‖f (x + y)‖ + ‖f (x - y)‖ : norm_add_le _ _
    ... ≤ k + k : add_le_add (hk₁ _) (hk₁ _)
    ... = 2 * k : (two_mul _).symm, },

  -- Suppose the conclusion does not hold.
  by_contra' hneg,
  set k' := k / ‖g y‖,

  -- Demonstrate that `k' < k` using `hneg`.
  have H₁ : k' < k,
  { have h₁ : 0 < k,
    { obtain ⟨x, hx⟩ := hf3,
      calc 0
          < ‖f x‖ : norm_pos_iff.mpr hx
      ... ≤ k : hk₁ x },
    rw div_lt_iff,
    apply lt_mul_of_one_lt_right h₁ hneg,
    exact trans zero_lt_one hneg },

  -- Demonstrate that `k ≤ k'` using `hk₂`.
  have H₂ : k ≤ k',
  { have h₁ : ∃ x : ℝ, x ∈ S,
    { use ‖f 0‖, exact set.mem_range_self 0, },
    have h₂ : ∀ x, ‖f x‖ ≤ k',
    { intros x,
      rw le_div_iff,
      { apply (mul_le_mul_left zero_lt_two).mp (hk₂ x) },
      { exact trans zero_lt_one hneg } },
    apply cSup_le h₁,
    rintros y' ⟨yy, rfl⟩,
    exact h₂ yy },

  -- Conclude by obtaining a contradiction, `k' < k'`.
  apply lt_irrefl k',
  calc k'
      < k : H₁
  ... ≤ k' : H₂,
end

/-- IMO 1972 Q5

Problem: `f` and `g` are real-valued functions defined on the real line. For all `x` and `y`,
`f(x + y) + f(x - y) = 2f(x)g(y)`. `f` is not identically zero and `|f(x)| ≤ 1` for all `x`.
Prove that `|g(x)| ≤ 1` for all `x`.

This is a more concise version of the proof proposed by Ruben Van de Velde.
-/
example (f g : ℝ → ℝ)
  (hf1 : ∀ x, ∀ y, (f (x+y) + f(x-y)) = 2 * f(x) * g(y))
  (hf2 : bdd_above (set.range (λ x, ‖f x‖)))
  (hf3 : ∃ x, f(x) ≠ 0)
  (y : ℝ) :
  ‖g(y)‖ ≤ 1 :=
begin
  obtain ⟨x, hx⟩ := hf3,
  set k := ⨆ x, ‖f x‖,
  have h : ∀ x, ‖f x‖ ≤ k := le_csupr hf2,
  by_contra' H,
  have hgy : 0 < ‖g y‖,
    by linarith,
  have k_pos : 0 < k := lt_of_lt_of_le (norm_pos_iff.mpr hx) (h x),
  have : k / ‖g y‖ < k := (div_lt_iff hgy).mpr (lt_mul_of_one_lt_right k_pos H),
  have : k ≤ k / ‖g y‖,
  { suffices : ∀ x, ‖f x‖ ≤ k / ‖g y‖, from csupr_le this,
    intro x,
    suffices : 2 * (‖f x‖ * ‖g y‖) ≤ 2 * k,
      by { rwa [le_div_iff hgy, ←mul_le_mul_left (zero_lt_two : (0 : ℝ) < 2)] },
    calc 2 * (‖f x‖ * ‖g y‖)
        = ‖2 * f x * g y‖           : by simp [abs_mul, mul_assoc]
    ... = ‖f (x + y) + f (x - y)‖   : by rw hf1
    ... ≤ ‖f (x + y)‖ + ‖f (x - y)‖ : abs_add _ _
    ... ≤ 2 * k                     : by linarith [h (x+y), h (x -y)] },
  linarith,
end