import .sets

namespace zfc
open tactic
/-
__Axiom Tactics__
This file contains a few tactics relating to the axioms of ZFC in sets.lean. While not particularly
useful, these tactics might be helpful in very specific scenarios. Here is an elevator pitch for each
one:

`by_axiom` This tactic allows you to easily solve a goal by applying the axioms of ZFC. Wow!

`list_axioms` Did you forget which axiomatic system you're working in again? Don't worry! This
  tactic shows you all of the axioms.

`explain_axioms` Why go into the sets.lean file when the sets.lean file can come to you? Use this
  tactic to see the gist of each axiom.

-/

/-__by_axiom__
  This tactic attempts to solve the current goal by applying an axiom. -/
meta def by_axiom : tactic unit :=
    ((do applyc `zfc.extensionality, trace "Applied Axiom of Extensionality", skip)  <|>
    (do applyc `zfc.pairing, trace "Applied Axiom of Pairing", skip) <|>
    (do applyc `zfc.separation, trace "Applied Axiom of Separation", skip) <|>
    (do applyc `zfc.empty_set, trace "Applied Axiom of Empty Set", skip) <|>
    (do applyc `zfc.union, trace "Applied Axiom of Union", skip) <|>
    (do applyc `zfc.power_set, trace "Applied Axiom of Power Set", skip) <|>
    (do applyc `zfc.infinity, trace "Applied Axiom of Infinity", skip) <|>
    (do applyc `zfc.replacement, trace "Applied Axiom of Replacement", skip) <|>
    (do applyc `zfc.regularity, trace "Applied Axiom of Regularity", skip) <|>
    (do applyc `zfc.choice, trace "Applied Axiom of Choice", skip)) <|>
    fail "Could not apply ZFC axioms to current state. Instead, enjoy this poem I wrote
    Roses are red,
    Violets are blue,
    ZFC is cool, I guess,
    But no one's as cool as you <3 B)"

/-__list_axioms__
  This tactic lists the axioms of ZFC that are implemented. -/
meta def list_axioms : tactic unit :=
  trace "-List of ZFC Axioms-
  Extensionality - `zfc.extensionality`
  Pairing        - `zfc.pairing`
  Separation     - `zfc.separation`
  Empty Set      - `zfc.empty_set`
  Union          - `zfc.union`
  Power Set      - `zfc.power_set`
  Infinity       - `zfc.infinity`
  Replacemnt     - `zfc.replacement`
  Regularity     - `zfc.regularity`
  Choice         - `zfc.choice`"

/-__list_axioms__
  This tactic attempts to explain each axiom.-/
meta def explain_axioms : tactic unit :=
  trace
  "<><>Extensionality<><>
  If two sets have the same elements, they are equal.

  <><>Pairing<><>
  Given two sets, there exists a set with only those two sets as elements.

  <><>Separation<><>
  Given some proposition P, we can separate some set into a subset whose elements all satisfy P.

  <><>Empty Set<><>
  There exists a set that has no elements.

  <><>Union<><>
  For any set X, there exists a set whose elements are all elements of elements of X.

  <><>Power Set<><>
  For any set X, there exists a set P(X) that is the collection of all subsets of X.

  <><>Infinity<><>
  There exists a set that can be built inductively, starting with the empty set and adding the union of elements of the set to the set.

  <><>Replacement<><>
  If F is a function on the set X, then the image F(X) is also a set.

  <><>Regularity<><>
  Every set has a minimal element with respect to ∈ (a set X can't contain itself, nor contain elements that contain X, etc.).

  <><>Choice<><>
  For any nonempty set, there exists a function that returns an element of that set.
  "

/-__Examples__-/
-- lemma example1 : (∀(s : Set), ∃(t : Set), ∀(sel sel_el tel: Set),
--   sel ∈ s → sel_el ∈ sel → tel ∈ t ↔ sel_el = tel) ∧ (∀(s: Set) (φ : Set → Set),
--    (∀(x y a : Set), x ∈ s ∧ φ(x) = y → φ(x) = a ↔ a = y) → ∃(t : Set), ∀(z x: Set),
--     x ∈ s → z ∈ t ↔ φ(x) = z) :=
--   begin
--     split,
--     repeat {by_axiom},
--   end

-- lemma example2 : true :=
--   begin
--     explain_axioms,
--     list_axioms,
--     by_axiom, --fails
--   end
end zfc


/-
Copyright (c) 2021 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import tactic.hint

/-!

# Intuitionistic tautology (`itauto`) decision procedure

The `itauto` tactic will prove any intuitionistic tautology. It implements the well known
`G4ip` algorithm:
[Dyckhoff, *Contraction-free sequent calculi for intuitionistic logic*][dyckhoff_1992].

All built in propositional connectives are supported: `true`, `false`, `and`, `or`, `implies`,
`not`, `iff`, `xor`, as well as `eq` and `ne` on propositions. Anything else, including definitions
and predicate logical connectives (`forall` and `exists`), are not supported, and will have to be
simplified or instantiated before calling this tactic.

The resulting proofs will never use any axioms except possibly `propext`, and `propext` is only
used if the input formula contains an equality of propositions `p = q`.

## Implementation notes

The core logic of the prover is in three functions:

* `prove : context → prop → state_t ℕ option proof`: The main entry point.
  Gets a context and a goal, and returns a `proof` object or fails, using `state_t ℕ` for the name
  generator.
* `search : context → prop → state_t ℕ option proof`: Same meaning as `proof`, called during the
  search phase (see below).
* `context.add : prop → proof → context → except (prop → proof) context`: Adds a proposition with
  its proof into the context, but it also does some simplifications on the spot while doing so.
  It will either return the new context, or if it happens to notice a proof of false, it will
  return a function to compute a proof of any proposition in the original context.

The intuitionistic logic rules are separated into three groups:

* level 1: No splitting, validity preserving: apply whenever you can.
  Left rules in `context.add`, right rules in `prove`.
  * `context.add`:
    * simplify `Γ, ⊤ ⊢ B` to `Γ ⊢ B`
    * `Γ, ⊥ ⊢ B` is true
    * simplify `Γ, A ∧ B ⊢ C` to `Γ, A, B ⊢ C`
    * simplify `Γ, ⊥ → A ⊢ B` to `Γ ⊢ B`
    * simplify `Γ, ⊤ → A ⊢ B` to `Γ, A ⊢ B`
    * simplify `Γ, A ∧ B → C ⊢ D` to `Γ, A → B → C ⊢ D`
    * simplify `Γ, A ∨ B → C ⊢ D` to `Γ, A → C, B → C ⊢ D`
  * `prove`:
    * `Γ ⊢ ⊤` is true
    * simplify `Γ ⊢ A → B` to `Γ, A ⊢ B`
  * `search`:
    * `Γ, P ⊢ P` is true
    * simplify `Γ, P, P → A ⊢ B` to `Γ, P, A ⊢ B`
* level 2: Splitting rules, validity preserving: apply after level 1 rules. Done in `prove`
  * simplify `Γ ⊢ A ∧ B` to `Γ ⊢ A` and `Γ ⊢ B`
  * simplify `Γ, A ∨ B ⊢ C` to `Γ, A ⊢ C` and `Γ, B ⊢ C`
* level 3: Splitting rules, not validity preserving: apply only if nothing else applies.
  Done in `search`
  * `Γ ⊢ A ∨ B` follows from `Γ ⊢ A`
  * `Γ ⊢ A ∨ B` follows from `Γ ⊢ B`
  * `Γ, (A₁ → A₂) → C ⊢ B` follows from `Γ, A₂ → C, A₁ ⊢ A₂` and `Γ, C ⊢ B`

This covers the core algorithm, which only handles `true`, `false`, `and`, `or`, and `implies`.
For `iff` and `eq`, we treat them essentially the same as `(p → q) ∧ (q → p)`, although we use
a different `prop` representation because we have to remember to apply different theorems during
replay. For definitions like `not` and `xor`, we just eagerly unfold them. (This could potentially
cause a blowup issue for `xor`, but it isn't used very often anyway. We could add it to the `prop`
grammar if it matters.)

## Tags

propositional logic, intuitionistic logic, decision procedure
-/

namespace tactic
namespace itauto

/-- Different propositional constructors that are variants of "and" for the purposes of the
theorem prover. -/
@[derive [has_reflect, decidable_eq]]
inductive and_kind | and | iff | eq

instance : inhabited and_kind := ⟨and_kind.and⟩

/-- A reified inductive type for propositional logic. -/
@[derive [has_reflect, decidable_eq]]
inductive prop : Type
| var : ℕ → prop            -- propositional atoms P_i
| true : prop               -- ⊤
| false : prop              -- ⊥
| and' : and_kind → prop → prop → prop  -- p ∧ q, p ↔ q, p = q
| or : prop → prop → prop   -- p ∨ q
| imp : prop → prop → prop  -- p → q

/-- Constructor for `p ∧ q`. -/
@[pattern] def prop.and : prop → prop → prop := prop.and' and_kind.and
/-- Constructor for `p ↔ q`. -/
@[pattern] def prop.iff : prop → prop → prop := prop.and' and_kind.iff
/-- Constructor for `p = q`. -/
@[pattern] def prop.eq : prop → prop → prop := prop.and' and_kind.eq
/-- Constructor for `¬ p`. -/
@[pattern] def prop.not (a : prop) : prop := a.imp prop.false
/-- Constructor for `xor p q`. -/
@[pattern] def prop.xor (a b : prop) : prop := (a.and b.not).or (b.and a.not)

instance : inhabited prop := ⟨prop.true⟩

/-- Given the contents of an `and` variant, return the two conjuncts. -/
def and_kind.sides : and_kind → prop → prop → prop × prop
| and_kind.and A B := (A, B)
| _ A B := (A.imp B, B.imp A)

/-- Debugging printer for propositions. -/
meta def prop.to_format : prop → format
| (prop.var i) := format!"v{i}"
| prop.true := format!"⊤"
| prop.false := format!"⊥"
| (prop.and p q) := format!"({p.to_format} ∧ {q.to_format})"
| (prop.iff p q) := format!"({p.to_format} ↔ {q.to_format})"
| (prop.eq p q) := format!"({p.to_format} = {q.to_format})"
| (prop.or p q) := format!"({p.to_format} ∨ {q.to_format})"
| (prop.imp p q) := format!"({p.to_format} → {q.to_format})"

meta instance : has_to_format prop := ⟨prop.to_format⟩

section
open ordering

/-- A comparator for `and_kind`. (There should really be a derive handler for this.) -/
def and_kind.cmp (p q : and_kind) : ordering :=
by { cases p; cases q, exacts [eq, lt, lt, gt, eq, lt, gt, gt, eq] }

/-- A comparator for propositions. (There should really be a derive handler for this.) -/
def prop.cmp (p q : prop) : ordering :=
begin
  induction p with _ ap _ _ p₁ p₂ _ _ p₁ p₂ _ _ p₁ p₂ _ _ p₁ p₂ generalizing q; cases q,
  case var var { exact cmp p q },
  case true true { exact eq },
  case false false { exact eq },
  case and' and' : aq q₁ q₂ { exact (ap.cmp aq).or_else ((p₁ q₁).or_else (p₂ q₂)) },
  case or or : q₁ q₂ { exact (p₁ q₁).or_else (p₂ q₂) },
  case imp imp : q₁ q₂ { exact (p₁ q₁).or_else (p₂ q₂) },
  exacts [lt, lt, lt, lt, lt,
          gt, lt, lt, lt, lt,
          gt, gt, lt, lt, lt,
          gt, gt, gt, lt, lt,
          gt, gt, gt, gt, lt,
          gt, gt, gt, gt, gt]
end

instance : has_lt prop := ⟨λ p q, p.cmp q = lt⟩

instance : decidable_rel (@has_lt.lt prop _) := λ _ _, ordering.decidable_eq _ _

end

/-- A reified inductive proof type for intuitionistic propositional logic. -/
@[derive has_reflect]
inductive proof
-- ⊢ A, causes failure during reconstruction
| «sorry» : proof
-- (n: A) ⊢ A
| hyp (n : name) : proof
-- ⊢ ⊤
| triv : proof
-- (p: ⊥) ⊢ A
| exfalso' (p : proof) : proof
-- (p: (x: A) ⊢ B) ⊢ A → B
| intro (x : name) (p : proof) : proof
-- ak = and:  (p: A ∧ B) ⊢ A
-- ak = iff:  (p: A ↔ B) ⊢ A → B
-- ak = eq:  (p: A = B) ⊢ A → B
| and_left (ak : and_kind) (p : proof) : proof
-- ak = and:  (p: A ∧ B) ⊢ B
-- ak = iff:  (p: A ↔ B) ⊢ B → A
-- ak = eq:  (p: A = B) ⊢ B → A
| and_right (ak : and_kind) (p : proof) : proof
-- ak = and:  (p₁: A) (p₂: B) ⊢ A ∧ B
-- ak = iff:  (p₁: A → B) (p₁: B → A) ⊢ A ↔ B
-- ak = eq:  (p₁: A → B) (p₁: B → A) ⊢ A = B
| and_intro (ak : and_kind) (p₁ p₂ : proof) : proof
-- ak = and:  (p: A ∧ B → C) ⊢ A → B → C
-- ak = iff:  (p: (A ↔ B) → C) ⊢ (A → B) → (B → A) → C
-- ak = eq:  (p: (A = B) → C) ⊢ (A → B) → (B → A) → C
| curry (ak : and_kind) (p : proof) : proof
-- This is a partial application of curry.
-- ak = and:  (p: A ∧ B → C) (q : A) ⊢ B → C
-- ak = iff:  (p: (A ↔ B) → C) (q: A → B) ⊢ (B → A) → C
-- ak = eq:  (p: (A ↔ B) → C) (q: A → B) ⊢ (B → A) → C
| curry₂ (ak : and_kind) (p q : proof) : proof
-- (p: A → B) (q: A) ⊢ B
| app' : proof → proof → proof
-- (p: A ∨ B → C) ⊢ A → C
| or_imp_left (p : proof) : proof
-- (p: A ∨ B → C) ⊢ B → C
| or_imp_right (p : proof) : proof
-- (p: A) ⊢ A ∨ B
| or_inl (p : proof) : proof
-- (p: B) ⊢ A ∨ B
| or_inr (p : proof) : proof
-- (p: B) ⊢ A ∨ B
-- (p₁: A ∨ B) (p₂: (x: A) ⊢ C) (p₃: (x: B) ⊢ C) ⊢ C
| or_elim' (p₁ : proof) (x : name) (p₂ p₃ : proof) : proof
-- (p₁: decidable A) (p₂: (x: A) ⊢ C) (p₃: (x: ¬ A) ⊢ C) ⊢ C
| decidable_elim (classical : bool) (p₁ x : name) (p₂ p₃ : proof) : proof
-- classical = ff: (p: decidable A) ⊢ A ∨ ¬A
-- classical = tt: (p: Prop) ⊢ p ∨ ¬p
| em (classical : bool) (p : name) : proof
-- The variable x here names the variable that will be used in the elaborated proof
-- (p: ((x:A) → B) → C) ⊢ B → C
| imp_imp_simp (x : name) (p : proof) : proof

instance : inhabited proof := ⟨proof.triv⟩

/-- Debugging printer for proof objects. -/
meta def proof.to_format : proof → format
| proof.sorry := "sorry"
| (proof.hyp i) := to_fmt i
| proof.triv := "triv"
| (proof.exfalso' p) := format!"(exfalso {p.to_format})"
| (proof.intro x p) := format!"(λ {x}, {p.to_format})"
| (proof.and_left _ p) := format!"{p.to_format} .1"
| (proof.and_right _ p) := format!"{p.to_format} .2"
| (proof.and_intro _ p q) := format!"⟨{p.to_format}, {q.to_format}⟩"
| (proof.curry _ p) := format!"(curry {p.to_format})"
| (proof.curry₂ _ p q) := format!"(curry {p.to_format} {q.to_format})"
| (proof.app' p q) := format!"({p.to_format} {q.to_format})"
| (proof.or_imp_left p) := format!"(or_imp_left {p.to_format})"
| (proof.or_imp_right p) := format!"(or_imp_right {p.to_format})"
| (proof.or_inl p) := format!"(or.inl {p.to_format})"
| (proof.or_inr p) := format!"(or.inr {p.to_format})"
| (proof.or_elim' p x q r) :=
  format!"({p.to_format}.elim (λ {x}, {q.to_format}) (λ {x}, {r.to_format})"
| (proof.em ff p) := format!"(decidable.em {p})"
| (proof.em tt p) := format!"(classical.em {p})"
| (proof.decidable_elim _ p x q r) :=
  format!"({p}.elim (λ {x}, {q.to_format}) (λ {x}, {r.to_format})"
| (proof.imp_imp_simp _ p) := format!"(imp_imp_simp {p.to_format})"

meta instance : has_to_format proof := ⟨proof.to_format⟩

/-- A variant on `proof.exfalso'` that performs opportunistic simplification. -/
meta def proof.exfalso : prop → proof → proof
| prop.false p := p
| A p := proof.exfalso' p

/-- A variant on `proof.or_elim` that performs opportunistic simplification. -/
meta def proof.or_elim : proof → name → proof → proof → proof
| (proof.em cl p) x q r := proof.decidable_elim cl p x q r
| p x q r := proof.or_elim' p x q r

/-- A variant on `proof.app'` that performs opportunistic simplification.
(This doesn't do full normalization because we don't want the proof size to blow up.) -/
meta def proof.app : proof → proof → proof
| (proof.curry ak p) q := proof.curry₂ ak p q
| (proof.curry₂ ak p q) r := p.app (q.and_intro ak r)
| (proof.or_imp_left p) q := p.app q.or_inl
| (proof.or_imp_right p) q := p.app q.or_inr
| (proof.imp_imp_simp x p) q := p.app (proof.intro x q)
| p q := p.app' q

-- Note(Mario): the typechecker is disabled because it requires proofs to carry around additional
-- props. These can be retrieved from the git history if you want to re-enable this.
/-
/-- A typechecker for the `proof` type. This is not used by the tactic but can be used for
debugging. -/
meta def proof.check : name_map prop → proof → option prop
| Γ (proof.hyp i) := Γ.find i
| Γ proof.triv := some prop.true
| Γ (proof.exfalso' A p) := guard (p.check Γ = some prop.false) $> A
| Γ (proof.intro x A p) := do B ← p.check (Γ.insert x A), pure (prop.imp A B)
| Γ (proof.and_left ak p) := do
  prop.and' ak' A B ← p.check Γ | none,
  guard (ak = ak') $> (ak.sides A B).1
| Γ (proof.and_right ak p) := do
  prop.and' ak' A B ← p.check Γ | none,
  guard (ak = ak') $> (ak.sides A B).2
| Γ (proof.and_intro and_kind.and p q) := do
  A ← p.check Γ, B ← q.check Γ,
  pure (A.and B)
| Γ (proof.and_intro ak p q) := do
  prop.imp A B ← p.check Γ | none,
  C ← q.check Γ, guard (C = prop.imp B A) $> (A.and' ak B)
| Γ (proof.curry ak p) := do
  prop.imp (prop.and' ak' A B) C ← p.check Γ | none,
  let (A', B') := ak.sides A B,
  guard (ak = ak') $> (A'.imp $ B'.imp C)
| Γ (proof.curry₂ ak p q) := do
  prop.imp (prop.and' ak' A B) C ← p.check Γ | none,
  A₂ ← q.check Γ,
  let (A', B') := ak.sides A B,
  guard (ak = ak' ∧ A₂ = A') $> (B'.imp C)
| Γ (proof.app' p q) := do prop.imp A B ← p.check Γ | none, A' ← q.check Γ, guard (A = A') $> B
| Γ (proof.or_imp_left B p) := do
  prop.imp (prop.or A B') C ← p.check Γ | none,
  guard (B = B') $> (A.imp C)
| Γ (proof.or_imp_right A p) := do
  prop.imp (prop.or A' B) C ← p.check Γ | none,
  guard (A = A') $> (B.imp C)
| Γ (proof.or_inl B p) := do A ← p.check Γ | none, pure (A.or B)
| Γ (proof.or_inr A p) := do B ← p.check Γ | none, pure (A.or B)
| Γ (proof.or_elim p x q r) := do
  prop.or A B ← p.check Γ | none,
  C ← q.check (Γ.insert x A),
  C' ← r.check (Γ.insert x B),
  guard (C = C') $> C
| Γ (proof.imp_imp_simp x A p) := do
  prop.imp (prop.imp A' B) C ← p.check Γ | none,
  guard (A = A') $> (B.imp C)
-/

/-- Get a new name in the pattern `h0, h1, h2, ...` -/
@[inline] meta def fresh_name : ℕ → name × ℕ :=
λ n, (mk_simple_name ("h" ++ to_string n), n+1)

/-- The context during proof search is a map from propositions to proof values. -/
meta def context := native.rb_map prop proof

/-- Debug printer for the context. -/
meta def context.to_format (Γ : context) : format :=
Γ.fold "" $ λ P p f, P.to_format /- ++ " := " ++ p.to_format -/ ++ ",\n" ++ f

meta instance : has_to_format context := ⟨context.to_format⟩

/-- Insert a proposition and its proof into the context, as in `have : A := p`. This will eagerly
apply all level 1 rules on the spot, which are rules that don't split the goal and are validity
preserving: specifically, we drop `⊤` and `A → ⊤` hypotheses, close the goal if we find a `⊥`
hypothesis, split all conjunctions, and also simplify `⊥ → A` (drop), `⊤ → A` (simplify to `A`),
`A ∧ B → C` (curry to `A → B → C`) and `A ∨ B → C` (rewrite to `(A → C) ∧ (B → C)` and split). -/
meta def context.add : prop → proof → context → except (prop → proof) context
| prop.true p Γ := pure Γ
| prop.false p Γ := except.error (λ A, proof.exfalso A p)
| (prop.and' ak A B) p Γ := do
  let (A, B) := ak.sides A B,
  Γ ← Γ.add A (p.and_left ak),
  Γ.add B (p.and_right ak)
| (prop.imp prop.false A) p Γ := pure Γ
| (prop.imp prop.true A) p Γ := Γ.add A (p.app proof.triv)
| (prop.imp (prop.and' ak A B) C) p Γ :=
  let (A, B) := ak.sides A B in
  Γ.add (prop.imp A (B.imp C)) (p.curry ak)
| (prop.imp (prop.or A B) C) p Γ := do
  Γ ← Γ.add (A.imp C) p.or_imp_left,
  Γ.add (B.imp C) p.or_imp_right
| (prop.imp A prop.true) p Γ := pure Γ
| A p Γ := pure (Γ.insert A p)

/-- Add `A` to the context `Γ` with proof `p`. This version of `context.add` takes a continuation
and a target proposition `B`, so that in the case that `⊥` is found we can skip the continuation
and just prove `B` outright. -/
@[inline] meta def context.with_add (Γ : context) (A : prop) (p : proof)
  (B : prop) (f : context → prop → ℕ → bool × proof × ℕ) (n : ℕ) : bool × proof × ℕ :=
match Γ.add A p with
| except.ok Γ_A := f Γ_A B n
| except.error p := (tt, p B, n)
end

/-- Map a function over the proof (regardless of whether the proof is successful or not). -/
def map_proof (f : proof → proof) : bool × proof × ℕ → bool × proof × ℕ
| (b, p, n) := (b, f p, n)

/-- Convert a value-with-success to an optional value. -/
def is_ok {α} : bool × α → option α
| (ff, p) := none
| (tt, p) := some p

/-- Skip the continuation and return a failed proof if the boolean is false. -/
def when_ok : bool → (ℕ → bool × proof × ℕ) → ℕ → bool × proof × ℕ
| ff f n := (ff, proof.sorry, n)
| tt f n := f n

/-- The search phase, which deals with the level 3 rules, which are rules that are not validity
preserving and so require proof search. One obvious one is the or-introduction rule: we prove
`A ∨ B` by proving `A` or `B`, and we might have to try one and backtrack.

There are two rules dealing with implication in this category: `p, p → C ⊢ B` where `p` is an
atom (which is safe if we can find it but often requires the right search to expose the `p`
assumption), and `(A₁ → A₂) → C ⊢ B`. We decompose the double implication into two subgoals: one to
prove `A₁ → A₂`, which can be written `A₂ → C, A₁ ⊢ A₂` (where we used `A₁` to simplify
`(A₁ → A₂) → C`), and one to use the consequent, `C ⊢ B`. The search here is that there are
potentially many implications to split like this, and we have to try all of them if we want to be
complete. -/
meta def search (prove : context → prop → ℕ → bool × proof × ℕ) :
  context → prop → ℕ → bool × proof × ℕ
| Γ B n := match Γ.find B with
  | some p := (tt, p, n)
  | none :=
    let search₁ := Γ.fold none $ λ A p r, match r with
    | some r := some r
    | none := match A with
      | prop.imp A' C := match Γ.find A' with
        | some q := is_ok $ context.with_add (Γ.erase A) C (p.app q) B prove n
        | none := match A' with
          | prop.imp A₁ A₂ := do
            let Γ : context := Γ.erase A,
            let (a, n) := fresh_name n,
            (p₁, n) ← is_ok $ Γ.with_add A₁ (proof.hyp a) A₂ (λ Γ_A₁ A₂,
              Γ_A₁.with_add (prop.imp A₂ C) (proof.imp_imp_simp a p) A₂ prove) n,
            is_ok $ Γ.with_add C (p.app (proof.intro a p₁)) B prove n
          | _ := none
          end
        end
      | _ := none
      end
    end in
    match search₁ with
    | some r := (tt, r)
    | none := match B with
      | prop.or B₁ B₂ := match map_proof proof.or_inl (prove Γ B₁ n) with
        | (ff, _) := map_proof proof.or_inr (prove Γ B₂ n)
        | r := r
        end
      | _ := (ff, proof.sorry, n)
      end
    end
  end

/-- The main prover. This receives a context of proven or assumed lemmas and a target proposition,
and returns a proof or `none` (with state for the fresh variable generator).
The intuitionistic logic rules are separated into three groups:

* level 1: No splitting, validity preserving: apply whenever you can.
  Left rules in `context.add`, right rules in `prove`
* level 2: Splitting rules, validity preserving: apply after level 1 rules. Done in `prove`
* level 3: Splitting rules, not validity preserving: apply only if nothing else applies.
  Done in `search`

The level 1 rules on the right of the turnstile are `Γ ⊢ ⊤` and `Γ ⊢ A → B`, these are easy to
handle. The rule `Γ ⊢ A ∧ B` is a level 2 rule, also handled here. If none of these apply, we try
the level 2 rule `A ∨ B ⊢ C` by searching the context and splitting all ors we find. Finally, if
we don't make any more progress, we go to the search phase.
-/
meta def prove : context → prop → ℕ → bool × proof × ℕ
| Γ prop.true n := (tt, proof.triv, n)
| Γ (prop.imp A B) n :=
  let (a, n) := fresh_name n in
  map_proof (proof.intro a) $ Γ.with_add A (proof.hyp a) B prove n
| Γ (prop.and' ak A B) n :=
  let (A, B) := ak.sides A B in
  let (b, p, n) := prove Γ A n in
  map_proof (p.and_intro ak) $ when_ok b (prove Γ B) n
| Γ B n := Γ.fold (λ b Γ, cond b prove (search prove) Γ B) (λ A p IH b Γ n,
    match A with
    | prop.or A₁ A₂ :=
      let Γ : context := Γ.erase A in
      let (a, n) := fresh_name n in
      let (b, p₁, n) := Γ.with_add A₁ (proof.hyp a) B (λ Γ _, IH tt Γ) n in
      map_proof (proof.or_elim p a p₁) $
        when_ok b (Γ.with_add A₂ (proof.hyp a) B (λ Γ _, IH tt Γ)) n
    | _ := IH b Γ n
    end) ff Γ n

/-- Reifies an atomic or otherwise unrecognized proposition. If it is defeq to a proposition we
have already allocated, we reuse it, otherwise we name it with a new index. -/
meta def reify_atom (atoms : ref (buffer expr)) (e : expr) : tactic prop := do
  vec ← read_ref atoms,
  o ← try_core $ vec.iterate failure (λ i e' r,
    r <|> (is_def_eq e e' >> pure i.1)),
  match o with
  | none := write_ref atoms (vec.push_back e) $> prop.var vec.size
  | some i := pure $ prop.var i
  end

/-- Reify an `expr` into a `prop`, allocating anything non-propositional as an atom in the
`atoms` list. -/
meta def reify (atoms : ref (buffer expr)) : expr → tactic prop
| `(true) := pure prop.true
| `(false) := pure prop.false
| `(¬ %%a) := prop.not <$> reify a
| `(%%a ∧ %%b) := prop.and <$> reify a <*> reify b
| `(%%a ∨ %%b) := prop.or <$> reify a <*> reify b
| `(%%a ↔ %%b) := prop.iff <$> reify a <*> reify b
| `(xor %%a %%b) := prop.xor <$> reify a <*> reify b
| `(@eq Prop %%a %%b) := prop.eq <$> reify a <*> reify b
| `(@ne Prop %%a %%b) := prop.not <$> (prop.eq <$> reify a <*> reify b)
| `(implies %%a %%b) := prop.imp <$> reify a <*> reify b
| e@`(%%a → %%b) :=
  if b.has_var then reify_atom atoms e else prop.imp <$> reify a <*> reify b
| e := reify_atom atoms e

/-- Once we have a proof object, we have to apply it to the goal. (Some of these cases are a bit
annoying because `applyc` gets the arguments wrong sometimes so we have to use `to_expr` instead.)
-/
meta def apply_proof : name_map expr → proof → tactic unit
| Γ proof.sorry := fail "itauto failed"
| Γ (proof.hyp n) := do e ← Γ.find n, exact e
| Γ proof.triv := triv
| Γ (proof.exfalso' p) := do
  t ← mk_mvar, to_expr ``(false.elim %%t) tt ff >>= exact,
  gs ← get_goals, set_goals (t::gs), apply_proof Γ p
| Γ (proof.intro x p) := do e ← intro_core x, apply_proof (Γ.insert x e) p
| Γ (proof.and_left and_kind.and p) := do
  t ← mk_mvar, to_expr ``(and.left %%t) tt ff >>= exact,
  gs ← get_goals, set_goals (t::gs), apply_proof Γ p
| Γ (proof.and_left and_kind.iff p) := do
  t ← mk_mvar, to_expr ``(iff.mp %%t) tt ff >>= exact,
  gs ← get_goals, set_goals (t::gs), apply_proof Γ p
| Γ (proof.and_left and_kind.eq p) := do
  t ← mk_mvar, to_expr ``(cast %%t) tt ff >>= exact,
  gs ← get_goals, set_goals (t::gs), apply_proof Γ p
| Γ (proof.and_right and_kind.and p) := do
  t ← mk_mvar, to_expr ``(and.right %%t) tt ff >>= exact,
  gs ← get_goals, set_goals (t::gs), apply_proof Γ p
| Γ (proof.and_right and_kind.iff p) := do
  t ← mk_mvar, to_expr ``(iff.mpr %%t) tt ff >>= exact,
  gs ← get_goals, set_goals (t::gs), apply_proof Γ p
| Γ (proof.and_right and_kind.eq p) := do
  t ← mk_mvar, to_expr ``(cast (eq.symm %%t)) tt ff >>= exact,
  gs ← get_goals, set_goals (t::gs), apply_proof Γ p
| Γ (proof.and_intro and_kind.and p q) := do
  t₁ ← mk_mvar, t₂ ← mk_mvar, to_expr ``(and.intro %%t₁ %%t₂) tt ff >>= exact,
  gs ← get_goals, set_goals (t₁::t₂::gs), apply_proof Γ p >> apply_proof Γ q
| Γ (proof.and_intro and_kind.iff p q) := do
  t₁ ← mk_mvar, t₂ ← mk_mvar, to_expr ``(iff.intro %%t₁ %%t₂) tt ff >>= exact,
  gs ← get_goals, set_goals (t₁::t₂::gs), apply_proof Γ p >> apply_proof Γ q
| Γ (proof.and_intro and_kind.eq p q) := do
  t₁ ← mk_mvar, t₂ ← mk_mvar, to_expr ``(propext (iff.intro %%t₁ %%t₂)) tt ff >>= exact,
  gs ← get_goals, set_goals (t₁::t₂::gs), apply_proof Γ p >> apply_proof Γ q
| Γ (proof.curry ak p) := do
  e ← intro_core `_, let n := e.local_uniq_name,
  apply_proof (Γ.insert n e) (proof.curry₂ ak p (proof.hyp n))
| Γ (proof.curry₂ ak p q) := do
  e ← intro_core `_, let n := e.local_uniq_name,
  apply_proof (Γ.insert n e) (p.app (q.and_intro ak (proof.hyp n)))
| Γ (proof.app' p q) := do
  A ← mk_meta_var (expr.sort level.zero),
  B ← mk_meta_var (expr.sort level.zero),
  g₁ ← mk_meta_var `((%%A : Prop) → (%%B : Prop)),
  g₂ ← mk_meta_var A,
  g :: gs ← get_goals,
  unify (g₁ g₂) g,
  set_goals (g₁::g₂::gs) >> apply_proof Γ p >> apply_proof Γ q
| Γ (proof.or_imp_left p) := do
  e ← intro_core `_, let n := e.local_uniq_name,
  apply_proof (Γ.insert n e) (p.app (proof.hyp n).or_inl)
| Γ (proof.or_imp_right p) := do
  e ← intro_core `_, let n := e.local_uniq_name,
  apply_proof (Γ.insert n e) (p.app (proof.hyp n).or_inr)
| Γ (proof.or_inl p) := do
  t ← mk_mvar, to_expr ``(or.inl %%t) tt ff >>= exact,
  gs ← get_goals, set_goals (t::gs), apply_proof Γ p
| Γ (proof.or_inr p) := do
  t ← mk_mvar, to_expr ``(or.inr %%t) tt ff >>= exact,
  gs ← get_goals, set_goals (t::gs), apply_proof Γ p
| Γ (proof.or_elim' p x p₁ p₂) := do
  t₁ ← mk_mvar, t₂ ← mk_mvar, t₃ ← mk_mvar, to_expr ``(or.elim %%t₁ %%t₂ %%t₃) tt ff >>= exact,
  gs ← get_goals, set_goals (t₁::t₂::t₃::gs), apply_proof Γ p,
  e ← intro_core x, apply_proof (Γ.insert x e) p₁,
  e ← intro_core x, apply_proof (Γ.insert x e) p₂
| Γ (proof.em ff n) := do
  e ← Γ.find n,
  to_expr ``(@decidable.em _ %%e) >>= exact
| Γ (proof.em tt n) := do
  e ← Γ.find n,
  to_expr ``(@classical.em %%e) >>= exact
| Γ (proof.decidable_elim ff n x p₁ p₂) := do
  e ← Γ.find n,
  t₁ ← mk_mvar, t₂ ← mk_mvar, to_expr ``(@dite _ _ %%e %%t₁ %%t₂) tt ff >>= exact,
  gs ← get_goals, set_goals (t₁::t₂::gs),
  e ← intro_core x, apply_proof (Γ.insert x e) p₁,
  e ← intro_core x, apply_proof (Γ.insert x e) p₂
| Γ (proof.decidable_elim tt n x p₁ p₂) := do
  e ← Γ.find n,
  e ← to_expr ``(@classical.dec %%e),
  t₁ ← mk_mvar, t₂ ← mk_mvar, to_expr ``(@dite _ _ %%e %%t₁ %%t₂) tt ff >>= exact,
  gs ← get_goals, set_goals (t₁::t₂::gs),
  e ← intro_core x, apply_proof (Γ.insert x e) p₁,
  e ← intro_core x, apply_proof (Γ.insert x e) p₂
| Γ (proof.imp_imp_simp x p) := do
  e ← intro_core `_, let n := e.local_uniq_name,
  apply_proof (Γ.insert n e) (p.app (proof.intro x (proof.hyp n)))

end itauto

open itauto

/-- A decision procedure for intuitionistic propositional logic.

* `use_dec` will add `a ∨ ¬ a` to the context for every decidable atomic proposition `a`.
* `use_classical` will allow `a ∨ ¬ a` to be added even if the proposition is not decidable,
  using classical logic.
* `extra_dec` will add `a ∨ ¬ a` to the context for specified (not necessarily atomic)
  propositions `a`.
-/
meta def itauto (use_dec use_classical : bool) (extra_dec : list expr) : tactic unit :=
using_new_ref mk_buffer $ λ atoms,
using_new_ref mk_name_map $ λ hs, do
  t ← target,
  t ← mcond (is_prop t) (reify atoms t) (tactic.exfalso $> prop.false),
  hyps ← local_context,
  (Γ, decs) ← hyps.mfoldl
    (λ (Γ : except (prop → proof) context × native.rb_map prop (bool × expr)) h, do
      e ← infer_type h,
      mcond (is_prop e)
        (do A ← reify atoms e,
          let n := h.local_uniq_name,
          read_ref hs >>= λ Γ, write_ref hs (Γ.insert n h),
          pure (Γ.1 >>= λ Γ', Γ'.add A (proof.hyp n), Γ.2))
        (match e with
        | `(decidable %%p) :=
          if use_dec then do
            A ← reify atoms p,
            let n := h.local_uniq_name,
            pure (Γ.1, Γ.2.insert A (ff, h))
          else pure Γ
        | _ := pure Γ
        end))
    (except.ok native.mk_rb_map, native.mk_rb_map),
  let add_dec (force : bool) (decs : native.rb_map prop (bool × expr)) (e : expr) := (do
    A ← reify atoms e,
    dec_e ← mk_app ``decidable [e],
    res ← try_core (mk_instance dec_e),
    if res.is_none ∧ ¬ use_classical then
      if force then do
        m ← mk_meta_var dec_e,
        set_goals [m] >> apply_instance >> failure
      else pure decs
    else
      pure (native.rb_map.insert decs A (res.elim (tt, e) (prod.mk ff)))),
  decs ← extra_dec.mfoldl (add_dec tt) decs,
  decs ← if use_dec then do
    let decided := match Γ with
    | except.ok Γ := Γ.fold native.mk_rb_set $ λ p _ m, match p with
      | prop.var i := m.insert i
      | prop.not (prop.var i) := m.insert i
      | _ := m
      end
    | except.error _ := native.mk_rb_set
    end,
    read_ref atoms >>= λ ats, ats.2.iterate (pure decs) $ λ i e r,
      if decided.contains i.1 then r else r >>= λ decs, add_dec ff decs e
  else pure decs,
  Γ ← decs.fold (pure Γ) (λ A ⟨cl, pf⟩ r, r >>= λ Γ, do
    n ← mk_fresh_name,
    read_ref hs >>= λ Γ, write_ref hs (Γ.insert n pf),
    pure (Γ >>= λ Γ', Γ'.add (A.or A.not) (proof.em cl n))),
  let p := match Γ with
  | except.ok Γ := (prove Γ t 0).2.1
  | except.error p := p t
  end,
  hs ← read_ref hs, apply_proof hs p

namespace interactive
setup_tactic_parser

/-- A decision procedure for intuitionistic propositional logic. Unlike `finish` and `tauto!` this
tactic never uses the law of excluded middle (without the `!` option), and the proof search is
tailored for this use case. (`itauto!` will work as a classical SAT solver, but the algorithm is
not very good in this situation.)

```lean
example (p : Prop) : ¬ (p ↔ ¬ p) := by itauto
```

`itauto [a, b]` will additionally attempt case analysis on `a` and `b` assuming that it can derive
`decidable a` and `decidable b`. `itauto *` will case on all decidable propositions that it can
find among the atomic propositions, and `itauto! *` will case on all propositional atoms.
*Warning:* This can blow up the proof search, so it should be used sparingly.
-/
meta def itauto (classical : parse (tk "!")?)
  : parse (some <$> pexpr_list <|> tk "*" *> pure none)? → tactic unit
| none := tactic.itauto false classical.is_some []
| (some none) := tactic.itauto true classical.is_some []
| (some (some ls)) := ls.mmap i_to_expr >>= tactic.itauto false classical.is_some

add_hint_tactic "itauto"

add_tactic_doc
{ name       := "itauto",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.itauto],
  tags       := ["logic", "propositional logic", "intuitionistic logic", "decision procedure"] }

end interactive
end tactic


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

/-!
# Frechet derivatives of analytic functions.

A function expressible as a power series at a point has a Frechet derivative there.
Also the special case in terms of `deriv` when the domain is 1-dimensional.
-/

open filter asymptotics
open_locale ennreal

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

section fderiv

variables {p : formal_multilinear_series 𝕜 E F} {r : ℝ≥0∞}
variables {f : E → F} {x : E} {s : set E}

lemma has_fpower_series_at.has_strict_fderiv_at (h : has_fpower_series_at f p x) :
  has_strict_fderiv_at f (continuous_multilinear_curry_fin1 𝕜 E F (p 1)) x :=
begin
  refine h.is_O_image_sub_norm_mul_norm_sub.trans_is_o (is_o.of_norm_right _),
  refine is_o_iff_exists_eq_mul.2 ⟨λ y, ‖y - (x, x)‖, _, eventually_eq.rfl⟩,
  refine (continuous_id.sub continuous_const).norm.tendsto' _ _ _,
  rw [_root_.id, sub_self, norm_zero]
end

lemma has_fpower_series_at.has_fderiv_at (h : has_fpower_series_at f p x) :
  has_fderiv_at f (continuous_multilinear_curry_fin1 𝕜 E F (p 1)) x :=
h.has_strict_fderiv_at.has_fderiv_at

lemma has_fpower_series_at.differentiable_at (h : has_fpower_series_at f p x) :
  differentiable_at 𝕜 f x :=
h.has_fderiv_at.differentiable_at

lemma analytic_at.differentiable_at : analytic_at 𝕜 f x → differentiable_at 𝕜 f x
| ⟨p, hp⟩ := hp.differentiable_at

lemma analytic_at.differentiable_within_at (h : analytic_at 𝕜 f x) :
  differentiable_within_at 𝕜 f s x :=
h.differentiable_at.differentiable_within_at

lemma has_fpower_series_at.fderiv_eq (h : has_fpower_series_at f p x) :
  fderiv 𝕜 f x = continuous_multilinear_curry_fin1 𝕜 E F (p 1) :=
h.has_fderiv_at.fderiv

lemma has_fpower_series_on_ball.differentiable_on [complete_space F]
  (h : has_fpower_series_on_ball f p x r) :
  differentiable_on 𝕜 f (emetric.ball x r) :=
λ y hy, (h.analytic_at_of_mem hy).differentiable_within_at

lemma analytic_on.differentiable_on (h : analytic_on 𝕜 f s) :
  differentiable_on 𝕜 f s :=
λ y hy, (h y hy).differentiable_within_at

lemma has_fpower_series_on_ball.has_fderiv_at [complete_space F]
  (h : has_fpower_series_on_ball f p x r) {y : E} (hy : (‖y‖₊ : ℝ≥0∞) < r) :
  has_fderiv_at f (continuous_multilinear_curry_fin1 𝕜 E F (p.change_origin y 1)) (x + y) :=
(h.change_origin hy).has_fpower_series_at.has_fderiv_at

lemma has_fpower_series_on_ball.fderiv_eq [complete_space F]
  (h : has_fpower_series_on_ball f p x r) {y : E} (hy : (‖y‖₊ : ℝ≥0∞) < r) :
  fderiv 𝕜 f (x + y) = continuous_multilinear_curry_fin1 𝕜 E F (p.change_origin y 1) :=
(h.has_fderiv_at hy).fderiv

/-- If a function has a power series on a ball, then so does its derivative. -/
lemma has_fpower_series_on_ball.fderiv [complete_space F]
  (h : has_fpower_series_on_ball f p x r) :
  has_fpower_series_on_ball (fderiv 𝕜 f)
    ((continuous_multilinear_curry_fin1 𝕜 E F : (E [×1]→L[𝕜] F) →L[𝕜] (E →L[𝕜] F))
      .comp_formal_multilinear_series (p.change_origin_series 1)) x r :=
begin
  suffices A : has_fpower_series_on_ball
    (λ z, continuous_multilinear_curry_fin1 𝕜 E F (p.change_origin (z - x) 1))
      ((continuous_multilinear_curry_fin1 𝕜 E F : (E [×1]→L[𝕜] F) →L[𝕜] (E →L[𝕜] F))
        .comp_formal_multilinear_series (p.change_origin_series 1)) x r,
  { apply A.congr,
    assume z hz,
    dsimp,
    rw [← h.fderiv_eq, add_sub_cancel'_right],
    simpa only [edist_eq_coe_nnnorm_sub, emetric.mem_ball] using hz},
  suffices B : has_fpower_series_on_ball (λ z, p.change_origin (z - x) 1)
    (p.change_origin_series 1) x r,
      from (continuous_multilinear_curry_fin1 𝕜 E F).to_continuous_linear_equiv
        .to_continuous_linear_map.comp_has_fpower_series_on_ball B,
  simpa using ((p.has_fpower_series_on_ball_change_origin 1 (h.r_pos.trans_le h.r_le)).mono
    h.r_pos h.r_le).comp_sub x,
end

/-- If a function is analytic on a set `s`, so is its Fréchet derivative. -/
lemma analytic_on.fderiv [complete_space F] (h : analytic_on 𝕜 f s) :
  analytic_on 𝕜 (fderiv 𝕜 f) s :=
begin
  assume y hy,
  rcases h y hy with ⟨p, r, hp⟩,
  exact hp.fderiv.analytic_at,
end

/-- If a function is analytic on a set `s`, so are its successive Fréchet derivative. -/
lemma analytic_on.iterated_fderiv [complete_space F] (h : analytic_on 𝕜 f s) (n : ℕ) :
  analytic_on 𝕜 (iterated_fderiv 𝕜 n f) s :=
begin
  induction n with n IH,
  { rw iterated_fderiv_zero_eq_comp,
    exact ((continuous_multilinear_curry_fin0 𝕜 E F).symm : F →L[𝕜] (E [×0]→L[𝕜] F))
      .comp_analytic_on h },
  { rw iterated_fderiv_succ_eq_comp_left,
    apply (continuous_multilinear_curry_left_equiv 𝕜 (λ (i : fin (n + 1)), E) F)
      .to_continuous_linear_equiv.to_continuous_linear_map.comp_analytic_on,
    exact IH.fderiv }
end

/-- An analytic function is infinitely differentiable. -/
lemma analytic_on.cont_diff_on [complete_space F] (h : analytic_on 𝕜 f s) {n : ℕ∞} :
  cont_diff_on 𝕜 n f s :=
begin
  let t := {x | analytic_at 𝕜 f x},
  suffices : cont_diff_on 𝕜 n f t, from this.mono h,
  have H : analytic_on 𝕜 f t := λ x hx, hx,
  have t_open : is_open t := is_open_analytic_at 𝕜 f,
  apply cont_diff_on_of_continuous_on_differentiable_on,
  { assume m hm,
    apply (H.iterated_fderiv m).continuous_on.congr,
    assume x hx,
    exact iterated_fderiv_within_of_is_open _ t_open hx },
  { assume m hm,
    apply (H.iterated_fderiv m).differentiable_on.congr,
    assume x hx,
    exact iterated_fderiv_within_of_is_open _ t_open hx }
end

end fderiv

section deriv

variables {p : formal_multilinear_series 𝕜 𝕜 F} {r : ℝ≥0∞}
variables {f : 𝕜 → F} {x : 𝕜} {s : set 𝕜}

protected lemma has_fpower_series_at.has_strict_deriv_at (h : has_fpower_series_at f p x) :
  has_strict_deriv_at f (p 1 (λ _, 1)) x :=
h.has_strict_fderiv_at.has_strict_deriv_at

protected lemma has_fpower_series_at.has_deriv_at (h : has_fpower_series_at f p x) :
  has_deriv_at f (p 1 (λ _, 1)) x :=
h.has_strict_deriv_at.has_deriv_at

protected lemma has_fpower_series_at.deriv (h : has_fpower_series_at f p x) :
  deriv f x = p 1 (λ _, 1) :=
h.has_deriv_at.deriv

/-- If a function is analytic on a set `s`, so is its derivative. -/
lemma analytic_on.deriv [complete_space F] (h : analytic_on 𝕜 f s) :
  analytic_on 𝕜 (deriv f) s :=
(continuous_linear_map.apply 𝕜 F (1 : 𝕜)).comp_analytic_on h.fderiv

/-- If a function is analytic on a set `s`, so are its successive derivatives. -/
lemma analytic_on.iterated_deriv [complete_space F] (h : analytic_on 𝕜 f s) (n : ℕ) :
  analytic_on 𝕜 (deriv^[n] f) s :=
begin
  induction n with n IH,
  { exact h },
  { simpa only [function.iterate_succ', function.comp_app] using IH.deriv }
end

end deriv


/-
Copyright (c) 2020 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.rat.meta_defs
import Mathlib.tactic.norm_num
import Mathlib.data.tree
import Mathlib.meta.expr
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# A tactic for canceling numeric denominators

This file defines tactics that cancel numeric denominators from field expressions.

As an example, we want to transform a comparison `5*(a/3 + b/4) < c/3` into the equivalent
`5*(4*a + 3*b) < 4*c`.

## Implementation notes

The tooling here was originally written for `linarith`, not intended as an interactive tactic.
The interactive version has been split off because it is sometimes convenient to use on its own.
There are likely some rough edges to it.

Improving this tactic would be a good project for someone interested in learning tactic programming.
-/

namespace cancel_factors

/-! ### Lemmas used in the procedure -/

theorem mul_subst {α : Type u_1} [comm_ring α] {n1 : α} {n2 : α} {k : α} {e1 : α} {e2 : α} {t1 : α} {t2 : α} (h1 : n1 * e1 = t1) (h2 : n2 * e2 = t2) (h3 : n1 * n2 = k) : k * (e1 * e2) = t1 * t2 := sorry

theorem div_subst {α : Type u_1} [field α] {n1 : α} {n2 : α} {k : α} {e1 : α} {e2 : α} {t1 : α} (h1 : n1 * e1 = t1) (h2 : n2 / e2 = 1) (h3 : n1 * n2 = k) : k * (e1 / e2) = t1 := sorry

theorem cancel_factors_eq_div {α : Type u_1} [field α] {n : α} {e : α} {e' : α} (h : n * e = e') (h2 : n ≠ 0) : e = e' / n :=
  eq_div_of_mul_eq h2 (eq.mp (Eq._oldrec (Eq.refl (n * e = e')) (mul_comm n e)) h)

theorem add_subst {α : Type u_1} [ring α] {n : α} {e1 : α} {e2 : α} {t1 : α} {t2 : α} (h1 : n * e1 = t1) (h2 : n * e2 = t2) : n * (e1 + e2) = t1 + t2 := sorry

theorem sub_subst {α : Type u_1} [ring α] {n : α} {e1 : α} {e2 : α} {t1 : α} {t2 : α} (h1 : n * e1 = t1) (h2 : n * e2 = t2) : n * (e1 - e2) = t1 - t2 := sorry

theorem neg_subst {α : Type u_1} [ring α] {n : α} {e : α} {t : α} (h1 : n * e = t) : n * -e = -t := sorry

theorem cancel_factors_lt {α : Type u_1} [linear_ordered_field α] {a : α} {b : α} {ad : α} {bd : α} {a' : α} {b' : α} {gcd : α} (ha : ad * a = a') (hb : bd * b = b') (had : 0 < ad) (hbd : 0 < bd) (hgcd : 0 < gcd) : a < b = (1 / gcd * (bd * a') < 1 / gcd * (ad * b')) := sorry

theorem cancel_factors_le {α : Type u_1} [linear_ordered_field α] {a : α} {b : α} {ad : α} {bd : α} {a' : α} {b' : α} {gcd : α} (ha : ad * a = a') (hb : bd * b = b') (had : 0 < ad) (hbd : 0 < bd) (hgcd : 0 < gcd) : a ≤ b = (1 / gcd * (bd * a') ≤ 1 / gcd * (ad * b')) := sorry

theorem cancel_factors_eq {α : Type u_1} [linear_ordered_field α] {a : α} {b : α} {ad : α} {bd : α} {a' : α} {b' : α} {gcd : α} (ha : ad * a = a') (hb : bd * b = b') (had : 0 < ad) (hbd : 0 < bd) (hgcd : 0 < gcd) : a = b = (1 / gcd * (bd * a') = 1 / gcd * (ad * b')) := sorry

/-! ### Computing cancelation factors -/

/--
`find_cancel_factor e` produces a natural number `n`, such that multiplying `e` by `n` will
be able to cancel all the numeric denominators in `e`. The returned `tree` describes how to
distribute the value `n` over products inside `e`.
-/
/--
`mk_prod_prf n tr e` produces a proof of `n*e = e'`, where numeric denominators have been
canceled in `e'`, distributing `n` proportionally according to `tr`.
-/
/--
Given `e`, a term with rational division, produces a natural number `n` and a proof of `n*e = e'`,
where `e'` has no division. Assumes "well-behaved" division.
-/
/--
Given `e`, a term with rational divison, produces a natural number `n` and a proof of `e = e' / n`,
where `e'` has no divison. Assumes "well-behaved" division.
-/
/--
`find_comp_lemma e` arranges `e` in the form `lhs R rhs`, where `R ∈ {<, ≤, =}`, and returns
`lhs`, `rhs`, and the `cancel_factors` lemma corresponding to `R`.
-/
/--
`cancel_denominators_in_type h` assumes that `h` is of the form `lhs R rhs`,
where `R ∈ {<, ≤, =, ≥, >}`.
It produces an expression `h'` of the form `lhs' R rhs'` and a proof that `h = h'`.
Numeric denominators have been canceled in `lhs'` and `rhs'`.
-/
end cancel_factors

/-! ### Interactive version -/

/--
`cancel_denoms` attempts to remove numerals from the denominators of fractions.
It works on propositions that are field-valued inequalities.

```lean
variables {α : Type} [linear_ordered_field α] (a b c : α)

example (h : a / 5 + b / 4 < c) : 4*a + 5*b < 20*c :=
begin
  cancel_denoms at h,
  exact h
end

example (h : a > 0) : a / 5 > 0 :=
begin
  cancel_denoms,
  exact h
end
```
-/


/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/
import linear_algebra.affine_space.affine_map
import topology.algebra.group
import topology.algebra.mul_action

/-!
# Topological properties of affine spaces and maps

For now, this contains only a few facts regarding the continuity of affine maps in the special
case when the point space and vector space are the same.

TODO: Deal with the case where the point spaces are different from the vector spaces. Note that
we do have some results in this direction under the assumption that the topologies are induced by
(semi)norms.
-/

namespace affine_map

variables {R E F : Type*}
variables [add_comm_group E] [topological_space E]
variables [add_comm_group F] [topological_space F] [topological_add_group F]

section ring

variables [ring R] [module R E] [module R F]

/-- An affine map is continuous iff its underlying linear map is continuous. See also
`affine_map.continuous_linear_iff`. -/
lemma continuous_iff {f : E →ᵃ[R] F} :
  continuous f ↔ continuous f.linear :=
begin
  split,
  { intro hc,
    rw decomp' f,
    have := hc.sub continuous_const,
    exact this, },
  { intro hc,
    rw decomp f,
    have := hc.add continuous_const,
    exact this }
end

/-- The line map is continuous. -/
@[continuity]
lemma line_map_continuous [topological_space R] [has_continuous_smul R F] {p v : F} :
  continuous ⇑(line_map p v : R →ᵃ[R] F) :=
continuous_iff.mpr $ (continuous_id.smul continuous_const).add $
  @continuous_const _ _ _ _ (0 : F)

end ring

section comm_ring

variables [comm_ring R] [module R F] [topological_space R] [has_continuous_smul R F]

@[continuity]
lemma homothety_continuous (x : F) (t : R) : continuous $ homothety x t :=
begin
  suffices : ⇑(homothety x t) = λ y, t • (y - x) + x, { rw this, continuity, },
  ext y,
  simp [homothety_apply],
end

end comm_ring

section field

variables [field R] [module R F] [topological_space R] [has_continuous_smul R F]

lemma homothety_is_open_map (x : F) (t : R) (ht : t ≠ 0) : is_open_map $ homothety x t :=
begin
  apply is_open_map.of_inverse (homothety_continuous x t⁻¹);
  intros e;
  simp [← affine_map.comp_apply, ← homothety_mul, ht],
end

end field

end affine_map


example (P Q R : Type) : (P → (Q → R)) → ((P → Q) → (P → R)) :=
begin
intros f g p,
have h : Q -> R := f p,
apply h,
exact g p,
end


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

! This file was ported from Lean 3 source module order.category.PartOrd
! leanprover-community/mathlib commit e8ac6315bcfcbaf2d19a046719c3b553206dac75
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.Antisymmetrization
import Mathbin.Order.Category.Preord

/-!
# Category of partial orders

This defines `PartOrd`, the category of partial orders with monotone maps.
-/

open CategoryTheory

universe u

/-- The category of partially ordered types. -/
def PartOrd :=
  Bundled PartialOrder
#align PartOrd PartOrd

namespace PartOrd

instance : BundledHom.ParentProjection @PartialOrder.toPreorder :=
  ⟨⟩

deriving instance LargeCategory, ConcreteCategory for PartOrd

instance : CoeSort PartOrd (Type _) :=
  Bundled.hasCoeToSort

/-- Construct a bundled PartOrd from the underlying type and typeclass. -/
def of (α : Type _) [PartialOrder α] : PartOrd :=
  Bundled.of α
#align PartOrd.of PartOrd.of

@[simp]
theorem coe_of (α : Type _) [PartialOrder α] : ↥(of α) = α :=
  rfl
#align PartOrd.coe_of PartOrd.coe_of

instance : Inhabited PartOrd :=
  ⟨of PUnit⟩

instance (α : PartOrd) : PartialOrder α :=
  α.str

instance hasForgetToPreord : HasForget₂ PartOrd Preord :=
  BundledHom.forget₂ _ _
#align PartOrd.has_forget_to_Preord PartOrd.hasForgetToPreord

/-- Constructs an equivalence between partial orders from an order isomorphism between them. -/
@[simps]
def Iso.mk {α β : PartOrd.{u}} (e : α ≃o β) : α ≅ β
    where
  Hom := e
  inv := e.symm
  hom_inv_id' := by
    ext
    exact e.symm_apply_apply x
  inv_hom_id' := by
    ext
    exact e.apply_symm_apply x
#align PartOrd.iso.mk PartOrd.Iso.mk

/-- `order_dual` as a functor. -/
@[simps]
def dual : PartOrd ⥤ PartOrd where
  obj X := of Xᵒᵈ
  map X Y := OrderHom.dual
#align PartOrd.dual PartOrd.dual

/-- The equivalence between `PartOrd` and itself induced by `order_dual` both ways. -/
@[simps Functor inverse]
def dualEquiv : PartOrd ≌ PartOrd :=
  Equivalence.mk dual dual
    (NatIso.ofComponents (fun X => Iso.mk <| OrderIso.dualDual X) fun X Y f => rfl)
    (NatIso.ofComponents (fun X => Iso.mk <| OrderIso.dualDual X) fun X Y f => rfl)
#align PartOrd.dual_equiv PartOrd.dualEquiv

end PartOrd

theorem partOrd_dual_comp_forget_to_preord :
    PartOrd.dual ⋙ forget₂ PartOrd Preord = forget₂ PartOrd Preord ⋙ Preord.dual :=
  rfl
#align PartOrd_dual_comp_forget_to_Preord partOrd_dual_comp_forget_to_preord

/-- `antisymmetrization` as a functor. It is the free functor. -/
def preordToPartOrd : Preord.{u} ⥤ PartOrd
    where
  obj X := PartOrd.of (Antisymmetrization X (· ≤ ·))
  map X Y f := f.Antisymmetrization
  map_id' X := by
    ext
    exact Quotient.inductionOn' x fun x => Quotient.map'_mk'' _ (fun a b => id) _
  map_comp' X Y Z f g := by
    ext
    exact Quotient.inductionOn' x fun x => OrderHom.antisymmetrization_apply_mk _ _
#align Preord_to_PartOrd preordToPartOrd

/-- `Preord_to_PartOrd` is left adjoint to the forgetful functor, meaning it is the free
functor from `Preord` to `PartOrd`. -/
def preordToPartOrdForgetAdjunction : preordToPartOrd.{u} ⊣ forget₂ PartOrd Preord :=
  Adjunction.mkOfHomEquiv
    { homEquiv := fun X Y =>
        { toFun := fun f =>
            ⟨f ∘ toAntisymmetrization (· ≤ ·), f.mono.comp toAntisymmetrization_mono⟩
          invFun := fun f =>
            ⟨fun a => Quotient.liftOn' a f fun a b h => (AntisymmRel.image h f.mono).Eq, fun a b =>
              Quotient.inductionOn₂' a b fun a b h => f.mono h⟩
          left_inv := fun f =>
            OrderHom.ext _ _ <| funext fun x => Quotient.inductionOn' x fun x => rfl
          right_inv := fun f => OrderHom.ext _ _ <| funext fun x => rfl }
      homEquiv_naturality_left_symm := fun X Y Z f g =>
        OrderHom.ext _ _ <| funext fun x => Quotient.inductionOn' x fun x => rfl
      homEquiv_naturality_right := fun X Y Z f g => OrderHom.ext _ _ <| funext fun x => rfl }
#align Preord_to_PartOrd_forget_adjunction preordToPartOrdForgetAdjunction

/-- `Preord_to_PartOrd` and `order_dual` commute. -/
@[simps]
def preordToPartOrdCompToDualIsoToDualCompPreordToPartOrd :
    preordToPartOrd.{u} ⋙ PartOrd.dual ≅ Preord.dual ⋙ preordToPartOrd :=
  NatIso.ofComponents (fun X => PartOrd.Iso.mk <| OrderIso.dualAntisymmetrization _) fun X Y f =>
    OrderHom.ext _ _ <| funext fun x => Quotient.inductionOn' x fun x => rfl
#align Preord_to_PartOrd_comp_to_dual_iso_to_dual_comp_Preord_to_PartOrd preordToPartOrdCompToDualIsoToDualCompPreordToPartOrd


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

! This file was ported from Lean 3 source module control.bitraversable.basic
! leanprover-community/mathlib commit 6f1d45dcccf674593073ee4e54da10ba35aedbc0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Control.Bifunctor
import Mathlib.Control.Traversable.Basic

/-!
# Bitraversable type class

Type class for traversing bifunctors.

Simple examples of `Bitraversable` are `Prod` and `Sum`. A more elaborate example is
to define an a-list as:

```
def AList (key val : Type) := List (key × val)
```

Then we can use `f : key → IO key'` and `g : val → IO val'` to manipulate the `AList`'s key
and value respectively with `Bitraverse f g : AList key val → IO (AList key' val')`.

## Main definitions

* `Bitraversable`: Bare typeclass to hold the `Bitraverse` function.
* `IsLawfulBitraversable`: Typeclass for the laws of the `Bitraverse` function. Similar to
  `IsLawfulTraversable`.

## References

The concepts and laws are taken from
<https://hackage.haskell.org/package/base-4.12.0.0/docs/Data-Bitraversable.html>

## Tags

traversable bitraversable iterator functor bifunctor applicative
-/

universe u

/-- Lawless bitraversable bifunctor. This only holds data for the bimap and bitraverse. -/
class Bitraversable (t : Type u → Type u → Type u) extends Bifunctor t where
  bitraverse :
    ∀ {m : Type u → Type u} [Applicative m] {α α' β β'},
      (α → m α') → (β → m β') → t α β → m (t α' β')
#align bitraversable Bitraversable

export Bitraversable (bitraverse)

/-- A bitraversable functor commutes with all applicative functors. -/
def bisequence {t m} [Bitraversable t] [Applicative m] {α β} : t (m α) (m β) → m (t α β) :=
  bitraverse id id
#align bisequence bisequence

open Functor

/-- Bifunctor. This typeclass asserts that a lawless bitraversable bifunctor is lawful. -/
class IsLawfulBitraversable (t : Type u → Type u → Type u) [Bitraversable t] extends
  LawfulBifunctor t where
  -- Porting note: need to specify `m := Id` because `id` no longer has a `Monad` instance
  id_bitraverse : ∀ {α β} (x : t α β), bitraverse (m := Id) pure pure x = pure x
  comp_bitraverse :
    ∀ {F G} [Applicative F] [Applicative G] [LawfulApplicative F] [LawfulApplicative G]
      {α α' β β' γ γ'} (f : β → F γ) (f' : β' → F γ') (g : α → G β) (g' : α' → G β') (x : t α α'),
      bitraverse (Comp.mk ∘ map f ∘ g) (Comp.mk ∘ map f' ∘ g') x =
        Comp.mk (bitraverse f f' <$> bitraverse g g' x)
  bitraverse_eq_bimap_id :
    ∀ {α α' β β'} (f : α → β) (f' : α' → β') (x : t α α'),
      bitraverse (m := Id) (pure ∘ f) (pure ∘ f') x = pure (bimap f f' x)
  binaturality :
    ∀ {F G} [Applicative F] [Applicative G] [LawfulApplicative F] [LawfulApplicative G]
      (η : ApplicativeTransformation F G) {α α' β β'} (f : α → F β) (f' : α' → F β') (x : t α α'),
      η (bitraverse f f' x) = bitraverse (@η _ ∘ f) (@η _ ∘ f') x
#align is_lawful_bitraversable IsLawfulBitraversable

export IsLawfulBitraversable (id_bitraverse comp_bitraverse bitraverse_eq_bimap_id)

open IsLawfulBitraversable

attribute [higher_order bitraverse_id_id] id_bitraverse

attribute [higher_order bitraverse_comp] comp_bitraverse

attribute [higher_order] binaturality bitraverse_eq_bimap_id

export IsLawfulBitraversable (bitraverse_id_id bitraverse_comp)


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.separation
import Mathlib.topology.bases
import Mathlib.PostPort

universes u_1 u_2 l u_3 u_4

namespace Mathlib

/-!
# Dense embeddings

This file defines three properties of functions:

* `dense_range f`      means `f` has dense image;
* `dense_inducing i`   means `i` is also `inducing`;
* `dense_embedding e`  means `e` is also an `embedding`.

The main theorem `continuous_extend` gives a criterion for a function
`f : X → Z` to a regular (T₃) space Z to extend along a dense embedding
`i : X → Y` to a continuous function `g : Y → Z`. Actually `i` only
has to be `dense_inducing` (not necessarily injective).

-/

/-- `i : α → β` is "dense inducing" if it has dense range and the topology on `α`
  is the one induced by `i` from the topology on `β`. -/
structure dense_inducing {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] (i : α → β)
extends inducing i
where
  dense : dense_range i

namespace dense_inducing

theorem nhds_eq_comap {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] {i : α → β} (di : dense_inducing i) (a : α) : nhds a = filter.comap i (nhds (i a)) :=
  inducing.nhds_eq_comap (to_inducing di)

protected theorem continuous {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] {i : α → β} (di : dense_inducing i) : continuous i :=
  inducing.continuous (to_inducing di)

theorem closure_range {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] {i : α → β} (di : dense_inducing i) : closure (set.range i) = set.univ :=
  dense_range.closure_range (dense di)

theorem self_sub_closure_image_preimage_of_open {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] {i : α → β} {s : set β} (di : dense_inducing i) : is_open s → s ⊆ closure (i '' (i ⁻¹' s)) := sorry

theorem closure_image_nhds_of_nhds {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] {i : α → β} {s : set α} {a : α} (di : dense_inducing i) : s ∈ nhds a → closure (i '' s) ∈ nhds (i a) := sorry

/-- The product of two dense inducings is a dense inducing -/
protected theorem prod {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} [topological_space α] [topological_space β] [topological_space γ] [topological_space δ] {e₁ : α → β} {e₂ : γ → δ} (de₁ : dense_inducing e₁) (de₂ : dense_inducing e₂) : dense_inducing fun (p : α × γ) => (e₁ (prod.fst p), e₂ (prod.snd p)) :=
  mk (inducing.mk (inducing.induced (inducing.prod_mk (to_inducing de₁) (to_inducing de₂))))
    (dense_range.prod_map (dense de₁) (dense de₂))

/-- If the domain of a `dense_inducing` map is a separable space, then so is the codomain. -/
protected theorem separable_space {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] {i : α → β} (di : dense_inducing i) [topological_space.separable_space α] : topological_space.separable_space β :=
  dense_range.separable_space (dense di) (dense_inducing.continuous di)

/--
 γ -f→ α
g↓     ↓e
 δ -h→ β
-/
theorem tendsto_comap_nhds_nhds {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} [topological_space α] [topological_space β] {i : α → β} [topological_space δ] {f : γ → α} {g : γ → δ} {h : δ → β} {d : δ} {a : α} (di : dense_inducing i) (H : filter.tendsto h (nhds d) (nhds (i a))) (comm : h ∘ g = i ∘ f) : filter.tendsto f (filter.comap g (nhds d)) (nhds a) := sorry

protected theorem nhds_within_ne_bot {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] {i : α → β} (di : dense_inducing i) (b : β) : filter.ne_bot (nhds_within b (set.range i)) :=
  dense_range.nhds_within_ne_bot (dense di) b

theorem comap_nhds_ne_bot {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] {i : α → β} (di : dense_inducing i) (b : β) : filter.ne_bot (filter.comap i (nhds b)) := sorry

/-- If `i : α → β` is a dense inducing, then any function `f : α → γ` "extends"
  to a function `g = extend di f : β → γ`. If `γ` is Hausdorff and `f` has a
  continuous extension, then `g` is the unique such extension. In general,
  `g` might not be continuous or even extend `f`. -/
def extend {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α] [topological_space β] {i : α → β} [topological_space γ] (di : dense_inducing i) (f : α → γ) (b : β) : γ :=
  lim (filter.comap i (nhds b)) f

theorem extend_eq_of_tendsto {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α] [topological_space β] {i : α → β} (di : dense_inducing i) [topological_space γ] [t2_space γ] {b : β} {c : γ} {f : α → γ} (hf : filter.tendsto f (filter.comap i (nhds b)) (nhds c)) : extend di f b = c :=
  filter.tendsto.lim_eq hf

theorem extend_eq_at {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α] [topological_space β] {i : α → β} (di : dense_inducing i) [topological_space γ] [t2_space γ] {f : α → γ} (a : α) (hf : continuous_at f a) : extend di f (i a) = f a :=
  extend_eq_of_tendsto di (nhds_eq_comap di a ▸ hf)

theorem extend_eq {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α] [topological_space β] {i : α → β} (di : dense_inducing i) [topological_space γ] [t2_space γ] {f : α → γ} (hf : continuous f) (a : α) : extend di f (i a) = f a :=
  extend_eq_at di a (continuous.continuous_at hf)

theorem extend_unique_at {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α] [topological_space β] {i : α → β} [topological_space γ] [t2_space γ] {b : β} {f : α → γ} {g : β → γ} (di : dense_inducing i) (hf : filter.eventually (fun (x : α) => g (i x) = f x) (filter.comap i (nhds b))) (hg : continuous_at g b) : extend di f b = g b := sorry

theorem extend_unique {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α] [topological_space β] {i : α → β} [topological_space γ] [t2_space γ] {f : α → γ} {g : β → γ} (di : dense_inducing i) (hf : ∀ (x : α), g (i x) = f x) (hg : continuous g) : extend di f = g :=
  funext fun (b : β) => extend_unique_at di (filter.eventually_of_forall hf) (continuous.continuous_at hg)

theorem continuous_at_extend {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α] [topological_space β] {i : α → β} [topological_space γ] [regular_space γ] {b : β} {f : α → γ} (di : dense_inducing i) (hf : filter.eventually (fun (x : β) => ∃ (c : γ), filter.tendsto f (filter.comap i (nhds x)) (nhds c)) (nhds b)) : continuous_at (extend di f) b := sorry

theorem continuous_extend {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α] [topological_space β] {i : α → β} [topological_space γ] [regular_space γ] {f : α → γ} (di : dense_inducing i) (hf : ∀ (b : β), ∃ (c : γ), filter.tendsto f (filter.comap i (nhds b)) (nhds c)) : continuous (extend di f) :=
  iff.mpr continuous_iff_continuous_at fun (b : β) => continuous_at_extend di (filter.univ_mem_sets' hf)

theorem mk' {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] (i : α → β) (c : continuous i) (dense : ∀ (x : β), x ∈ closure (set.range i)) (H : ∀ (a : α) (s : set α) (H : s ∈ nhds a), ∃ (t : set β), ∃ (H : t ∈ nhds (i a)), ∀ (b : α), i b ∈ t → b ∈ s) : dense_inducing i := sorry

end dense_inducing

/-- A dense embedding is an embedding with dense image. -/
structure dense_embedding {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] (e : α → β)
extends dense_inducing e
where
  inj : function.injective e

theorem dense_embedding.mk' {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] (e : α → β) (c : continuous e) (dense : dense_range e) (inj : function.injective e) (H : ∀ (a : α) (s : set α) (H : s ∈ nhds a), ∃ (t : set β), ∃ (H : t ∈ nhds (e a)), ∀ (b : α), e b ∈ t → b ∈ s) : dense_embedding e := sorry

namespace dense_embedding

theorem inj_iff {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] {e : α → β} (de : dense_embedding e) {x : α} {y : α} : e x = e y ↔ x = y :=
  function.injective.eq_iff (inj de)

theorem to_embedding {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] {e : α → β} (de : dense_embedding e) : embedding e :=
  embedding.mk (inducing.mk (inducing.induced (dense_inducing.to_inducing (to_dense_inducing de)))) (inj de)

/-- If the domain of a `dense_embedding` is a separable space, then so is its codomain. -/
protected theorem separable_space {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] {e : α → β} (de : dense_embedding e) [topological_space.separable_space α] : topological_space.separable_space β :=
  dense_inducing.separable_space (to_dense_inducing de)

/-- The product of two dense embeddings is a dense embedding. -/
protected theorem prod {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} [topological_space α] [topological_space β] [topological_space γ] [topological_space δ] {e₁ : α → β} {e₂ : γ → δ} (de₁ : dense_embedding e₁) (de₂ : dense_embedding e₂) : dense_embedding fun (p : α × γ) => (e₁ (prod.fst p), e₂ (prod.snd p)) := sorry

/-- The dense embedding of a subtype inside its closure. -/
def subtype_emb {β : Type u_2} [topological_space β] {α : Type u_1} (p : α → Prop) (e : α → β) (x : Subtype fun (x : α) => p x) : Subtype fun (x : β) => x ∈ closure (e '' set_of fun (x : α) => p x) :=
  { val := e ↑x, property := sorry }

protected theorem subtype {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] {e : α → β} (de : dense_embedding e) (p : α → Prop) : dense_embedding (subtype_emb p e) := sorry

end dense_embedding

theorem is_closed_property {α : Type u_1} {β : Type u_2} [topological_space β] {e : α → β} {p : β → Prop} (he : dense_range e) (hp : is_closed (set_of fun (x : β) => p x)) (h : ∀ (a : α), p (e a)) (b : β) : p b := sorry

theorem is_closed_property2 {α : Type u_1} {β : Type u_2} [topological_space β] {e : α → β} {p : β → β → Prop} (he : dense_range e) (hp : is_closed (set_of fun (q : β × β) => p (prod.fst q) (prod.snd q))) (h : ∀ (a₁ a₂ : α), p (e a₁) (e a₂)) (b₁ : β) (b₂ : β) : p b₁ b₂ :=
  (fun (this : ∀ (q : β × β), p (prod.fst q) (prod.snd q)) (b₁ b₂ : β) => this (b₁, b₂))
    (is_closed_property (dense_range.prod_map he he) hp fun (_x : α × α) => h (prod.fst _x) (prod.snd _x))

theorem is_closed_property3 {α : Type u_1} {β : Type u_2} [topological_space β] {e : α → β} {p : β → β → β → Prop} (he : dense_range e) (hp : is_closed (set_of fun (q : β × β × β) => p (prod.fst q) (prod.fst (prod.snd q)) (prod.snd (prod.snd q)))) (h : ∀ (a₁ a₂ a₃ : α), p (e a₁) (e a₂) (e a₃)) (b₁ : β) (b₂ : β) (b₃ : β) : p b₁ b₂ b₃ := sorry

theorem dense_range.induction_on {α : Type u_1} {β : Type u_2} [topological_space β] {e : α → β} (he : dense_range e) {p : β → Prop} (b₀ : β) (hp : is_closed (set_of fun (b : β) => p b)) (ih : ∀ (a : α), p (e a)) : p b₀ :=
  is_closed_property he hp ih b₀

theorem dense_range.induction_on₂ {α : Type u_1} {β : Type u_2} [topological_space β] {e : α → β} {p : β → β → Prop} (he : dense_range e) (hp : is_closed (set_of fun (q : β × β) => p (prod.fst q) (prod.snd q))) (h : ∀ (a₁ a₂ : α), p (e a₁) (e a₂)) (b₁ : β) (b₂ : β) : p b₁ b₂ :=
  is_closed_property2 he hp h b₁ b₂

theorem dense_range.induction_on₃ {α : Type u_1} {β : Type u_2} [topological_space β] {e : α → β} {p : β → β → β → Prop} (he : dense_range e) (hp : is_closed (set_of fun (q : β × β × β) => p (prod.fst q) (prod.fst (prod.snd q)) (prod.snd (prod.snd q)))) (h : ∀ (a₁ a₂ a₃ : α), p (e a₁) (e a₂) (e a₃)) (b₁ : β) (b₂ : β) (b₃ : β) : p b₁ b₂ b₃ :=
  is_closed_property3 he hp h b₁ b₂ b₃

/-- Two continuous functions to a t2-space that agree on the dense range of a function are equal. -/
theorem dense_range.equalizer {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space β] [topological_space γ] [t2_space γ] {f : α → β} (hfd : dense_range f) {g : β → γ} {h : β → γ} (hg : continuous g) (hh : continuous h) (H : g ∘ f = h ∘ f) : g = h :=
  funext fun (y : β) => dense_range.induction_on hfd y (is_closed_eq hg hh) (congr_fun H)


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

! This file was ported from Lean 3 source module category_theory.bicategory.natural_transformation
! leanprover-community/mathlib commit 4ff75f5b8502275a4c2eb2d2f02bdf84d7fb8993
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Bicategory.Functor

/-!
# Oplax natural transformations

Just as there are natural transformations between functors, there are oplax natural transformations
between oplax functors. The equality in the naturality of natural transformations is replaced by a
specified 2-morphism `F.map f ≫ app b ⟶ app a ≫ G.map f` in the case of oplax natural
transformations.

## Main definitions

* `oplax_nat_trans F G` : oplax natural transformations between oplax functors `F` and `G`
* `oplax_nat_trans.vcomp η θ` : the vertical composition of oplax natural transformations `η`
  and `θ`
* `oplax_nat_trans.category F G` : the category structure on the oplax natural transformations
  between `F` and `G`
-/

namespace CategoryTheory

open Category Bicategory

open Bicategory

universe w₁ w₂ v₁ v₂ u₁ u₂

variable {B : Type u₁} [Bicategory.{w₁, v₁} B] {C : Type u₂} [Bicategory.{w₂, v₂} C]

/-- If `η` is an oplax natural transformation between `F` and `G`, we have a 1-morphism
`η.app a : F.obj a ⟶ G.obj a` for each object `a : B`. We also have a 2-morphism
`η.naturality f : F.map f ≫ app b ⟶ app a ≫ G.map f` for each 1-morphism `f : a ⟶ b`.
These 2-morphisms satisfies the naturality condition, and preserve the identities and
the compositions modulo some adjustments of domains and codomains of 2-morphisms.
-/
structure OplaxNatTrans (F G : OplaxFunctor B C) where
  app (a : B) : F.obj a ⟶ G.obj a
  naturality {a b : B} (f : a ⟶ b) : F.map f ≫ app b ⟶ app a ≫ G.map f
  naturality_naturality' :
    ∀ {a b : B} {f g : a ⟶ b} (η : f ⟶ g),
      F.zipWith η ▷ app b ≫ naturality g = naturality f ≫ app a ◁ G.zipWith η := by
    obviously
  naturality_id' :
    ∀ a : B,
      naturality (𝟙 a) ≫ app a ◁ G.map_id a =
        F.map_id a ▷ app a ≫ (λ_ (app a)).Hom ≫ (ρ_ (app a)).inv := by
    obviously
  naturality_comp' :
    ∀ {a b c : B} (f : a ⟶ b) (g : b ⟶ c),
      naturality (f ≫ g) ≫ app a ◁ G.map_comp f g =
        F.map_comp f g ▷ app c ≫
          (α_ _ _ _).Hom ≫
            F.map f ◁ naturality g ≫ (α_ _ _ _).inv ≫ naturality f ▷ G.map g ≫ (α_ _ _ _).Hom := by
    obviously
#align category_theory.oplax_nat_trans CategoryTheory.OplaxNatTrans

restate_axiom oplax_nat_trans.naturality_naturality'

restate_axiom oplax_nat_trans.naturality_id'

restate_axiom oplax_nat_trans.naturality_comp'

attribute [simp, reassoc.1]
  oplax_nat_trans.naturality_naturality oplax_nat_trans.naturality_id oplax_nat_trans.naturality_comp

namespace OplaxNatTrans

section

variable (F : OplaxFunctor B C)

/-- The identity oplax natural transformation. -/
@[simps]
def id : OplaxNatTrans F F where
  app a := 𝟙 (F.obj a)
  naturality a b f := (ρ_ (F.map f)).Hom ≫ (λ_ (F.map f)).inv
#align category_theory.oplax_nat_trans.id CategoryTheory.OplaxNatTrans.id

instance : Inhabited (OplaxNatTrans F F) :=
  ⟨id F⟩

variable {F} {G H : OplaxFunctor B C} (η : OplaxNatTrans F G) (θ : OplaxNatTrans G H)

section

variable {a b c : B} {a' : C}

@[simp, reassoc.1]
theorem whiskerLeft_naturality_naturality (f : a' ⟶ G.obj a) {g h : a ⟶ b} (β : g ⟶ h) :
    f ◁ G.zipWith β ▷ θ.app b ≫ f ◁ θ.naturality h =
      f ◁ θ.naturality g ≫ f ◁ θ.app a ◁ H.zipWith β :=
  by simp_rw [← bicategory.whisker_left_comp, naturality_naturality]
#align category_theory.oplax_nat_trans.whisker_left_naturality_naturality CategoryTheory.OplaxNatTrans.whiskerLeft_naturality_naturality

@[simp, reassoc.1]
theorem whiskerRight_naturality_naturality {f g : a ⟶ b} (β : f ⟶ g) (h : G.obj b ⟶ a') :
    F.zipWith β ▷ η.app b ▷ h ≫ η.naturality g ▷ h =
      η.naturality f ▷ h ≫ (α_ _ _ _).Hom ≫ η.app a ◁ G.zipWith β ▷ h ≫ (α_ _ _ _).inv :=
  by rw [← comp_whisker_right, naturality_naturality, comp_whisker_right, whisker_assoc]
#align category_theory.oplax_nat_trans.whisker_right_naturality_naturality CategoryTheory.OplaxNatTrans.whiskerRight_naturality_naturality

@[simp, reassoc.1]
theorem whiskerLeft_naturality_comp (f : a' ⟶ G.obj a) (g : a ⟶ b) (h : b ⟶ c) :
    f ◁ θ.naturality (g ≫ h) ≫ f ◁ θ.app a ◁ H.map_comp g h =
      f ◁ G.map_comp g h ▷ θ.app c ≫
        f ◁ (α_ _ _ _).Hom ≫
          f ◁ G.map g ◁ θ.naturality h ≫
            f ◁ (α_ _ _ _).inv ≫ f ◁ θ.naturality g ▷ H.map h ≫ f ◁ (α_ _ _ _).Hom :=
  by simp_rw [← bicategory.whisker_left_comp, naturality_comp]
#align category_theory.oplax_nat_trans.whisker_left_naturality_comp CategoryTheory.OplaxNatTrans.whiskerLeft_naturality_comp

@[simp, reassoc.1]
theorem whiskerRight_naturality_comp (f : a ⟶ b) (g : b ⟶ c) (h : G.obj c ⟶ a') :
    η.naturality (f ≫ g) ▷ h ≫ (α_ _ _ _).Hom ≫ η.app a ◁ G.map_comp f g ▷ h =
      F.map_comp f g ▷ η.app c ▷ h ≫
        (α_ _ _ _).Hom ▷ h ≫
          (α_ _ _ _).Hom ≫
            F.map f ◁ η.naturality g ▷ h ≫
              (α_ _ _ _).inv ≫
                (α_ _ _ _).inv ▷ h ≫
                  η.naturality f ▷ G.map g ▷ h ≫ (α_ _ _ _).Hom ▷ h ≫ (α_ _ _ _).Hom :=
  by
  rw [← associator_naturality_middle, ← comp_whisker_right_assoc, naturality_comp]
  simp
#align category_theory.oplax_nat_trans.whisker_right_naturality_comp CategoryTheory.OplaxNatTrans.whiskerRight_naturality_comp

@[simp, reassoc.1]
theorem whiskerLeft_naturality_id (f : a' ⟶ G.obj a) :
    f ◁ θ.naturality (𝟙 a) ≫ f ◁ θ.app a ◁ H.map_id a =
      f ◁ G.map_id a ▷ θ.app a ≫ f ◁ (λ_ (θ.app a)).Hom ≫ f ◁ (ρ_ (θ.app a)).inv :=
  by simp_rw [← bicategory.whisker_left_comp, naturality_id]
#align category_theory.oplax_nat_trans.whisker_left_naturality_id CategoryTheory.OplaxNatTrans.whiskerLeft_naturality_id

@[simp, reassoc.1]
theorem whiskerRight_naturality_id (f : G.obj a ⟶ a') :
    η.naturality (𝟙 a) ▷ f ≫ (α_ _ _ _).Hom ≫ η.app a ◁ G.map_id a ▷ f =
      F.map_id a ▷ η.app a ▷ f ≫ (λ_ (η.app a)).Hom ▷ f ≫ (ρ_ (η.app a)).inv ▷ f ≫ (α_ _ _ _).Hom :=
  by
  rw [← associator_naturality_middle, ← comp_whisker_right_assoc, naturality_id]
  simp
#align category_theory.oplax_nat_trans.whisker_right_naturality_id CategoryTheory.OplaxNatTrans.whiskerRight_naturality_id

end

/-- Vertical composition of oplax natural transformations. -/
@[simps]
def vcomp (η : OplaxNatTrans F G) (θ : OplaxNatTrans G H) : OplaxNatTrans F H
    where
  app a := η.app a ≫ θ.app a
  naturality a b f :=
    (α_ _ _ _).inv ≫
      η.naturality f ▷ θ.app b ≫ (α_ _ _ _).Hom ≫ η.app a ◁ θ.naturality f ≫ (α_ _ _ _).inv
  naturality_comp' a b c f g :=
    by
    calc
      _ =
          _ ≫
            F.map_comp f g ▷ η.app c ▷ θ.app c ≫
              _ ≫
                F.map f ◁ η.naturality g ▷ θ.app c ≫
                  _ ≫
                    (F.map f ≫ η.app b) ◁ θ.naturality g ≫
                      η.naturality f ▷ (θ.app b ≫ H.map g) ≫
                        _ ≫ η.app a ◁ θ.naturality f ▷ H.map g ≫ _ :=
        _
      _ = _ := _

    exact (α_ _ _ _).inv
    exact (α_ _ _ _).Hom ▷ _ ≫ (α_ _ _ _).Hom
    exact _ ◁ (α_ _ _ _).Hom ≫ (α_ _ _ _).inv
    exact (α_ _ _ _).Hom ≫ _ ◁ (α_ _ _ _).inv
    exact _ ◁ (α_ _ _ _).Hom ≫ (α_ _ _ _).inv
    · rw [whisker_exchange_assoc]
      simp
    · simp
#align category_theory.oplax_nat_trans.vcomp CategoryTheory.OplaxNatTrans.vcomp

variable (B C)

@[simps]
instance : CategoryStruct (OplaxFunctor B C)
    where
  Hom := OplaxNatTrans
  id := OplaxNatTrans.id
  comp F G H := OplaxNatTrans.vcomp

end

section

variable {F G : OplaxFunctor B C}

/-- A modification `Γ` between oplax natural transformations `η` and `θ` consists of a family of
2-morphisms `Γ.app a : η.app a ⟶ θ.app a`, which satisfies the equation
`(F.map f ◁ app b) ≫ θ.naturality f = η.naturality f ≫ (app a ▷ G.map f)`
for each 1-morphism `f : a ⟶ b`.
-/
@[ext]
structure Modification (η θ : F ⟶ G) where
  app (a : B) : η.app a ⟶ θ.app a
  naturality' :
    ∀ {a b : B} (f : a ⟶ b),
      F.map f ◁ app b ≫ θ.naturality f = η.naturality f ≫ app a ▷ G.map f := by
    obviously
#align category_theory.oplax_nat_trans.modification CategoryTheory.OplaxNatTrans.Modification

restate_axiom modification.naturality'

attribute [simp, reassoc.1] modification.naturality

variable {η θ ι : F ⟶ G}

namespace Modification

variable (η)

/-- The identity modification. -/
@[simps]
def id : Modification η η where app a := 𝟙 (η.app a)
#align category_theory.oplax_nat_trans.modification.id CategoryTheory.OplaxNatTrans.Modification.id

instance : Inhabited (Modification η η) :=
  ⟨Modification.id η⟩

variable {η}

section

variable (Γ : Modification η θ) {a b c : B} {a' : C}

@[simp, reassoc.1]
theorem whiskerLeft_naturality (f : a' ⟶ F.obj b) (g : b ⟶ c) :
    f ◁ F.map g ◁ Γ.app c ≫ f ◁ θ.naturality g = f ◁ η.naturality g ≫ f ◁ Γ.app b ▷ G.map g := by
  simp_rw [← bicategory.whisker_left_comp, naturality]
#align category_theory.oplax_nat_trans.modification.whisker_left_naturality CategoryTheory.OplaxNatTrans.Modification.whiskerLeft_naturality

@[simp, reassoc.1]
theorem whiskerRight_naturality (f : a ⟶ b) (g : G.obj b ⟶ a') :
    F.map f ◁ Γ.app b ▷ g ≫ (α_ _ _ _).inv ≫ θ.naturality f ▷ g =
      (α_ _ _ _).inv ≫ η.naturality f ▷ g ≫ Γ.app a ▷ G.map f ▷ g :=
  by simp_rw [associator_inv_naturality_middle_assoc, ← comp_whisker_right, naturality]
#align category_theory.oplax_nat_trans.modification.whisker_right_naturality CategoryTheory.OplaxNatTrans.Modification.whiskerRight_naturality

end

/-- Vertical composition of modifications. -/
@[simps]
def vcomp (Γ : Modification η θ) (Δ : Modification θ ι) : Modification η ι
    where app a := Γ.app a ≫ Δ.app a
#align category_theory.oplax_nat_trans.modification.vcomp CategoryTheory.OplaxNatTrans.Modification.vcomp

end Modification

/-- Category structure on the oplax natural transformations between oplax_functors. -/
@[simps]
instance category (F G : OplaxFunctor B C) : Category (F ⟶ G)
    where
  Hom := Modification
  id := Modification.id
  comp η θ ι := Modification.vcomp
#align category_theory.oplax_nat_trans.category CategoryTheory.OplaxNatTrans.category

/-- Construct a modification isomorphism between oplax natural transformations
by giving object level isomorphisms, and checking naturality only in the forward direction.
-/
@[simps]
def ModificationIso.ofComponents (app : ∀ a, η.app a ≅ θ.app a)
    (naturality :
      ∀ {a b} (f : a ⟶ b),
        F.map f ◁ (app b).Hom ≫ θ.naturality f = η.naturality f ≫ (app a).Hom ▷ G.map f) :
    η ≅ θ where
  Hom := { app := fun a => (app a).Hom }
  inv :=
    { app := fun a => (app a).inv
      naturality' := fun a b f => by
        simpa using congr_arg (fun f => _ ◁ (app b).inv ≫ f ≫ (app a).inv ▷ _) (naturality f).symm }
#align category_theory.oplax_nat_trans.modification_iso.of_components CategoryTheory.OplaxNatTrans.ModificationIso.ofComponents

end

end OplaxNatTrans

end CategoryTheory


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

! This file was ported from Lean 3 source module data.option.n_ary
! leanprover-community/mathlib commit 995b47e555f1b6297c7cf16855f1023e355219fb
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Option.Basic

/-!
# Binary map of options

This file defines the binary map of `Option`. This is mostly useful to define pointwise operations
on intervals.

## Main declarations

* `Option.map₂`: Binary map of options.

## Notes

This file is very similar to the n-ary section of `Mathlib.Data.Set.Basic`, to
`Mathlib.Data.Finset.NAry` and to `Mathlib.Order.Filter.NAry`. Please keep them in sync.
(porting note - only some of these may exist right now!)

We do not define `Option.map₃` as its only purpose so far would be to prove properties of
`Option.map₂` and casing already fulfills this task.
-/

open Function

namespace Option

variable {f : α → β → γ} {a : Option α} {b : Option β} {c : Option γ}

/-- The image of a binary function `f : α → β → γ` as a function `Option α → Option β → Option γ`.
Mathematically this should be thought of as the image of the corresponding function `α × β → γ`. -/
def map₂ (f : α → β → γ) (a : Option α) (b : Option β) : Option γ :=
  a.bind fun a => b.map <| f a
#align option.map₂ Option.map₂

/-- `Option.map₂` in terms of monadic operations. Note that this can't be taken as the definition
because of the lack of universe polymorphism. -/
theorem map₂_def {α β γ : Type _} (f : α → β → γ) (a : Option α) (b : Option β) :
    map₂ f a b = f <$> a <*> b :=
  by cases a <;> rfl
#align option.map₂_def Option.map₂_def

-- porting note: In Lean3, was `@[simp]` but now `simp` can prove it
theorem map₂_some_some (f : α → β → γ) (a : α) (b : β) : map₂ f (some a) (some b) = f a b := rfl
#align option.map₂_some_some Option.map₂_some_some

theorem map₂_coe_coe (f : α → β → γ) (a : α) (b : β) : map₂ f a b = f a b := rfl
#align option.map₂_coe_coe Option.map₂_coe_coe

@[simp]
theorem map₂_none_left (f : α → β → γ) (b : Option β) : map₂ f none b = none := rfl
#align option.map₂_none_left Option.map₂_none_left

@[simp]
theorem map₂_none_right (f : α → β → γ) (a : Option α) : map₂ f a none = none := by cases a <;> rfl
#align option.map₂_none_right Option.map₂_none_right

@[simp]
theorem map₂_coe_left (f : α → β → γ) (a : α) (b : Option β) : map₂ f a b = b.map fun b => f a b :=
  rfl
#align option.map₂_coe_left Option.map₂_coe_left

-- porting note: This proof was `rfl` in Lean3, but now is not.
@[simp]
theorem map₂_coe_right (f : α → β → γ) (a : Option α) (b : β) : map₂ f a b = a.map fun a => f a b :=
  by cases a <;> rfl
#align option.map₂_coe_right Option.map₂_coe_right

-- porting note: Removed the `@[simp]` tag as membership of an `Option` is no-longer simp-normal.
theorem mem_map₂_iff {c : γ} : c ∈ map₂ f a b ↔ ∃ a' b', a' ∈ a ∧ b' ∈ b ∧ f a' b' = c :=
  by simp [map₂]
#align option.mem_map₂_iff Option.mem_map₂_iff

@[simp]
theorem map₂_eq_none_iff : map₂ f a b = none ↔ a = none ∨ b = none :=
  by cases a <;> cases b <;> simp
#align option.map₂_eq_none_iff Option.map₂_eq_none_iff

theorem map₂_swap (f : α → β → γ) (a : Option α) (b : Option β) :
    map₂ f a b = map₂ (fun a b => f b a) b a := by cases a <;> cases b <;> rfl
#align option.map₂_swap Option.map₂_swap

theorem map_map₂ (f : α → β → γ) (g : γ → δ) :
    (map₂ f a b).map g = map₂ (fun a b => g (f a b)) a b := by cases a <;> cases b <;> rfl
#align option.map_map₂ Option.map_map₂

theorem map₂_map_left (f : γ → β → δ) (g : α → γ) :
    map₂ f (a.map g) b = map₂ (fun a b => f (g a) b) a b := by cases a <;> rfl
#align option.map₂_map_left Option.map₂_map_left

@[simp]
theorem map₂_curry (f : α × β → γ) (a : Option α) (b : Option β) :
    map₂ (curry f) a b = Option.map f (map₂ Prod.mk a b) := (map_map₂ _ _).symm
#align option.map₂_curry Option.map₂_curry

@[simp]
theorem map_uncurry (f : α → β → γ) (x : Option (α × β)) :
    x.map (uncurry f) = map₂ f (x.map Prod.fst) (x.map Prod.snd) := by cases x <;> rfl
#align option.map_uncurry Option.map_uncurry

/-!
### Algebraic replacement rules

A collection of lemmas to transfer associativity, commutativity, distributivity, ... of operations
to the associativity, commutativity, distributivity, ... of `Option.map₂` of those operations.
The proof pattern is `map₂_lemma operation_lemma`. For example, `map₂_comm mul_comm` proves that
`map₂ (*) a b = map₂ (*) g f` in a `CommSemigroup`.
-/

theorem map₂_assoc {f : δ → γ → ε} {g : α → β → δ} {f' : α → ε' → ε} {g' : β → γ → ε'}
    (h_assoc : ∀ a b c, f (g a b) c = f' a (g' b c)) :
    map₂ f (map₂ g a b) c = map₂ f' a (map₂ g' b c) :=
  by cases a <;> cases b <;> cases c <;> simp [h_assoc]
#align option.map₂_assoc Option.map₂_assoc

theorem map₂_comm {g : β → α → γ} (h_comm : ∀ a b, f a b = g b a) : map₂ f a b = map₂ g b a :=
  by cases a <;> cases b <;> simp [h_comm]
#align option.map₂_comm Option.map₂_comm

theorem map₂_left_comm {f : α → δ → ε} {g : β → γ → δ} {f' : α → γ → δ'} {g' : β → δ' → ε}
    (h_left_comm : ∀ a b c, f a (g b c) = g' b (f' a c)) :
    map₂ f a (map₂ g b c) = map₂ g' b (map₂ f' a c) :=
  by cases a <;> cases b <;> cases c <;> simp [h_left_comm]
#align option.map₂_left_comm Option.map₂_left_comm

theorem map₂_right_comm {f : δ → γ → ε} {g : α → β → δ} {f' : α → γ → δ'} {g' : δ' → β → ε}
    (h_right_comm : ∀ a b c, f (g a b) c = g' (f' a c) b) :
    map₂ f (map₂ g a b) c = map₂ g' (map₂ f' a c) b :=
  by cases a <;> cases b <;> cases c <;> simp [h_right_comm]
#align option.map₂_right_comm Option.map₂_right_comm

theorem map_map₂_distrib {g : γ → δ} {f' : α' → β' → δ} {g₁ : α → α'} {g₂ : β → β'}
    (h_distrib : ∀ a b, g (f a b) = f' (g₁ a) (g₂ b)) :
    (map₂ f a b).map g = map₂ f' (a.map g₁) (b.map g₂) :=
  by cases a <;> cases b <;> simp [h_distrib]
#align option.map_map₂_distrib Option.map_map₂_distrib

/-!
The following symmetric restatement are needed because unification has a hard time figuring all the
functions if you symmetrize on the spot. This is also how the other n-ary APIs do it.
-/

/-- Symmetric statement to `Option.map₂_map_left_comm`. -/
theorem map_map₂_distrib_left {g : γ → δ} {f' : α' → β → δ} {g' : α → α'}
    (h_distrib : ∀ a b, g (f a b) = f' (g' a) b) :
    (map₂ f a b).map g = map₂ f' (a.map g') b := by cases a <;> cases b <;> simp [h_distrib]
#align option.map_map₂_distrib_left Option.map_map₂_distrib_left

/-- Symmetric statement to `Option.map_map₂_right_comm`. -/
theorem map_map₂_distrib_right {g : γ → δ} {f' : α → β' → δ} {g' : β → β'}
    (h_distrib : ∀ a b, g (f a b) = f' a (g' b)) : (map₂ f a b).map g = map₂ f' a (b.map g') :=
  by cases a <;> cases b <;> simp [h_distrib]
#align option.map_map₂_distrib_right Option.map_map₂_distrib_right

/-- Symmetric statement to `Option.map_map₂_distrib_left`. -/
theorem map₂_map_left_comm {f : α' → β → γ} {g : α → α'} {f' : α → β → δ} {g' : δ → γ}
    (h_left_comm : ∀ a b, f (g a) b = g' (f' a b)) : map₂ f (a.map g) b = (map₂ f' a b).map g' :=
  by cases a <;> cases b <;> simp [h_left_comm]
#align option.map₂_map_left_comm Option.map₂_map_left_comm

/-- Symmetric statement to `Option.map_map₂_distrib_right`. -/
theorem map_map₂_right_comm {f : α → β' → γ} {g : β → β'} {f' : α → β → δ} {g' : δ → γ}
    (h_right_comm : ∀ a b, f a (g b) = g' (f' a b)) : map₂ f a (b.map g) = (map₂ f' a b).map g' :=
  by cases a <;> cases b <;> simp [h_right_comm]
#align option.map_map₂_right_comm Option.map_map₂_right_comm

theorem map_map₂_antidistrib {g : γ → δ} {f' : β' → α' → δ} {g₁ : β → β'} {g₂ : α → α'}
    (h_antidistrib : ∀ a b, g (f a b) = f' (g₁ b) (g₂ a)) :
    (map₂ f a b).map g = map₂ f' (b.map g₁) (a.map g₂) :=
  by cases a <;> cases b <;> simp [h_antidistrib]
#align option.map_map₂_antidistrib Option.map_map₂_antidistrib

/-- Symmetric statement to `Option.map₂_map_left_anticomm`. -/
theorem map_map₂_antidistrib_left {g : γ → δ} {f' : β' → α → δ} {g' : β → β'}
    (h_antidistrib : ∀ a b, g (f a b) = f' (g' b) a) :
    (map₂ f a b).map g = map₂ f' (b.map g') a :=
  by cases a <;> cases b <;> simp [h_antidistrib]
#align option.map_map₂_antidistrib_left Option.map_map₂_antidistrib_left

/-- Symmetric statement to `Option.map_map₂_right_anticomm`. -/
theorem map_map₂_antidistrib_right {g : γ → δ} {f' : β → α' → δ} {g' : α → α'}
    (h_antidistrib : ∀ a b, g (f a b) = f' b (g' a)) : (map₂ f a b).map g = map₂ f' b (a.map g') :=
  by cases a <;> cases b <;> simp [h_antidistrib]
#align option.map_map₂_antidistrib_right Option.map_map₂_antidistrib_right

/-- Symmetric statement to `Option.map_map₂_antidistrib_left`. -/
theorem map₂_map_left_anticomm {f : α' → β → γ} {g : α → α'} {f' : β → α → δ} {g' : δ → γ}
    (h_left_anticomm : ∀ a b, f (g a) b = g' (f' b a)) :
    map₂ f (a.map g) b = (map₂ f' b a).map g' := by cases a <;> cases b <;> simp [h_left_anticomm]
#align option.map₂_map_left_anticomm Option.map₂_map_left_anticomm

/-- Symmetric statement to `Option.map_map₂_antidistrib_right`. -/
theorem map_map₂_right_anticomm {f : α → β' → γ} {g : β → β'} {f' : β → α → δ} {g' : δ → γ}
    (h_right_anticomm : ∀ a b, f a (g b) = g' (f' b a)) :
    map₂ f a (b.map g) = (map₂ f' b a).map g' := by cases a <;> cases b <;> simp [h_right_anticomm]
#align option.map_map₂_right_anticomm Option.map_map₂_right_anticomm

/-- If `a` is a left identity for a binary operation `f`, then `some a` is a left identity for
`Option.map₂ f`. -/
lemma map₂_left_identity {f : α → β → β} {a : α} (h : ∀ b, f a b = b) (o : Option β) :
    map₂ f (some a) o = o := by
  cases o; exacts [rfl, congr_arg some (h _)]
#align option.map₂_left_identity Option.map₂_left_identity

/-- If `b` is a right identity for a binary operation `f`, then `some b` is a right identity for
`Option.map₂ f`. -/
lemma map₂_right_identity {f : α → β → α} {b : β} (h : ∀ a, f a b = a) (o : Option α) :
    map₂ f o (some b) = o := by
  simp [h, map₂]
#align option.map₂_right_identity Option.map₂_right_identity

end Option


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

! This file was ported from Lean 3 source module data.fun_like.fintype
! leanprover-community/mathlib commit 13a5329a8625701af92e9a96ffc90fa787fff24d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Finite.Basic
import Mathbin.Data.Fintype.Basic
import Mathbin.Data.FunLike.Basic

/-!
# Finiteness of `fun_like` types

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

We show a type `F` with a `fun_like F α β` is finite if both `α` and `β` are finite.
This corresponds to the following two pairs of declarations:

 * `fun_like.fintype` is a definition stating all `fun_like`s are finite if their domain and
   codomain are.
 * `fun_like.finite` is a lemma stating all `fun_like`s are finite if their domain and
   codomain are.
 * `fun_like.fintype'` is a non-dependent version of `fun_like.fintype` and
 * `fun_like.finite` is a non-dependent version of `fun_like.finite`, because dependent instances
   are harder to infer.

You can use these to produce instances for specific `fun_like` types.
(Although there might be options for `fintype` instances with better definitional behaviour.)
They can't be instances themselves since they can cause loops.
-/

section Type

variable (F G : Type _) {α γ : Type _} {β : α → Type _} [FunLike F α β] [FunLike G α fun _ => γ]

#print FunLike.fintype /-
/-- All `fun_like`s are finite if their domain and codomain are.

This is not an instance because specific `fun_like` types might have a better-suited definition.

See also `fun_like.finite`.
-/
noncomputable def FunLike.fintype [DecidableEq α] [Fintype α] [∀ i, Fintype (β i)] : Fintype F :=
  Fintype.ofInjective _ FunLike.coe_injective
#align fun_like.fintype FunLike.fintype
-/

#print FunLike.fintype' /-
/-- All `fun_like`s are finite if their domain and codomain are.

Non-dependent version of `fun_like.fintype` that might be easier to infer.
This is not an instance because specific `fun_like` types might have a better-suited definition.
-/
noncomputable def FunLike.fintype' [DecidableEq α] [Fintype α] [Fintype γ] : Fintype G :=
  FunLike.fintype G
#align fun_like.fintype' FunLike.fintype'
-/

end Type

section Sort

variable (F G : Sort _) {α γ : Sort _} {β : α → Sort _} [FunLike F α β] [FunLike G α fun _ => γ]

/- warning: fun_like.finite -> FunLike.finite is a dubious translation:
lean 3 declaration is
  forall (F : Sort.{u1}) {α : Sort.{u2}} {β : α -> Sort.{u3}} [_inst_1 : FunLike.{u1, u2, u3} F α β] [_inst_3 : Finite.{u2} α] [_inst_4 : forall (i : α), Finite.{u3} (β i)], Finite.{u1} F
but is expected to have type
  forall (F : Sort.{u1}) {α : Sort.{u3}} {β : α -> Sort.{u2}} [_inst_1 : FunLike.{u1, u3, u2} F α β] [_inst_3 : Finite.{u3} α] [_inst_4 : forall (i : α), Finite.{u2} (β i)], Finite.{u1} F
Case conversion may be inaccurate. Consider using '#align fun_like.finite FunLike.finiteₓ'. -/
/-- All `fun_like`s are finite if their domain and codomain are.

Can't be an instance because it can cause infinite loops.
-/
theorem FunLike.finite [Finite α] [∀ i, Finite (β i)] : Finite F :=
  Finite.of_injective _ FunLike.coe_injective
#align fun_like.finite FunLike.finite

/- warning: fun_like.finite' -> FunLike.finite' is a dubious translation:
lean 3 declaration is
  forall (G : Sort.{u1}) {α : Sort.{u2}} {γ : Sort.{u3}} [_inst_2 : FunLike.{u1, u2, u3} G α (fun (_x : α) => γ)] [_inst_3 : Finite.{u2} α] [_inst_4 : Finite.{u3} γ], Finite.{u1} G
but is expected to have type
  forall (G : Sort.{u1}) {α : Sort.{u3}} {γ : Sort.{u2}} [_inst_2 : FunLike.{u1, u3, u2} G α (fun (_x : α) => γ)] [_inst_3 : Finite.{u3} α] [_inst_4 : Finite.{u2} γ], Finite.{u1} G
Case conversion may be inaccurate. Consider using '#align fun_like.finite' FunLike.finite'ₓ'. -/
/-- All `fun_like`s are finite if their domain and codomain are.

Non-dependent version of `fun_like.finite` that might be easier to infer.
Can't be an instance because it can cause infinite loops.
-/
theorem FunLike.finite' [Finite α] [Finite γ] : Finite G :=
  FunLike.finite G
#align fun_like.finite' FunLike.finite'

end Sort