import
  tactic.induction
  tactic.linarith
  ..semantics
  ..syntax

open instruction exp val bin_op big_step vm_big_step

lemma example1 :
 vm_big_step
  ([],
   [IPush (VNat 10),
    IPush (VNat 20),
    IOp EqOp,
    IBranch 1,
    IPush (VNat 1),
    IPush (VNat 2),
    IPush (VNat 3)],
  [])
  [VNat 3, VNat 2] :=
begin
  repeat { apply RunPush },
  apply RunOpInstr,
  rw [eval],
  apply RunFBranch,
  { rw [at_least, list.length],
    apply nat.le_add_left },
  repeat { rw [list.drop]},
  repeat { apply RunPush },
  exact RunEmpty
end

lemma example2 : ¬ ∃ out,
 vm_big_step
  ([], [IPush (VNat 10), IPush (VBool false), IOp EqOp], []) out :=
begin
  assume hexists,
  cases' hexists,
  repeat { cases' h }
end

lemma example3 :
  ([],
   [IPush (VBool false),
    IBranch 1,
    IBranch 10,
    IPush (VNat 2),
    IJump 1,
    IPush (VNat 2),
    IPush (VNat 3),
    IOp PlusOp], [])
  ⟹ᵥₘ [VNat 5] :=
begin
  apply RunPush,
  apply RunFBranch,
  { rw [at_least, list.length],
    linarith },
  { repeat { rw [list.drop] },
    apply RunPush,
    apply RunJump,
    { rw [at_least, list.length], linarith },
    { repeat { rw [list.drop] },
      apply RunPush,
      apply RunOpInstr,
      exact RunEmpty
    }
  }
end

lemma example4 :
  ∀ n, n ≠ 0 →
  ¬ ∃ out, ([], [IBranch n], [VBool false]) ⟹ᵥₘ out :=
begin
  assume n hnz hex,
  cases hex with hout hstep,
  cases hstep; rename hstep__x → hleast,
  cases hleast,
  contradiction
end

lemma unbound_var_no_out :
  ∀ x, ¬ ∃ out, EVar x ⟹ out :=
begin
  assume x,
  assume hex,
  cases hex with hval hstep,
  cases hstep
end

lemma test_name_shadow :
  ELet "x" (ELet "x" (EVal (VNat 1))
              (EOp PlusOp (EVar "x") (EVal (VNat 2))))
    (ELet "x" (EVal (VNat 0))
        (EOp EqOp (EVar "x") (EVal (VNat 0)))) ⟹ VBool true :=
begin
  apply RunLet,
  { apply RunLet,
    { apply RunVal },
    { repeat {rw subst},
      apply RunOp,
      simp,
      exact RunVal,
      exact RunVal } },
  { repeat {rw subst},
    simp,
    apply RunLet,
    repeat {apply RunVal},
    repeat {rw subst},
    simp,
    have heq : VBool tt = eval 0 0 EqOp := by refl,
    rw heq,
    apply RunOp,
    exact RunVal,
    exact RunVal
  }
end

lemma test_ext :
  ([],
   [IPush (VNat 0),
    IPush (VNat 1),
    IOpenScope "x",
    IOpenScope "y",
    IPush (VNat 2),
    ILookup "x",
    ICloseScope,
    IOp PlusOp], []) ⟹ᵥₘ [VNat 3] :=
begin
  apply RunPush,
  apply RunPush,
  apply RunOpenScope,
  apply RunOpenScope,
  apply RunPush,
  apply RunLookup,
  { apply bound.btail,
    finish,
    apply bound.bhead },
  apply RunCloseScope,
  have h : VNat 3 = eval 1 2 PlusOp := by refl,
  rw h,
  apply RunOpInstr,
  exact RunEmpty
end


/-
Copyright (c) 2021 Alena Gusakov, Bhavik Mehta, Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alena Gusakov, Bhavik Mehta, Kyle Miller

! This file was ported from Lean 3 source module combinatorics.hall.finite
! leanprover-community/mathlib commit 63f84d91dd847f50bae04a01071f3a5491934e36
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fintype.Basic
import Mathbin.Data.Set.Finite

/-!
# Hall's Marriage Theorem for finite index types

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

This module proves the basic form of Hall's theorem.
In constrast to the theorem described in `combinatorics.hall.basic`, this
version requires that the indexed family `t : ι → finset α` have `ι` be finite.
The `combinatorics.hall.basic` module applies a compactness argument to this version
to remove the `finite` constraint on `ι`.

The modules are split like this since the generalized statement
depends on the topology and category theory libraries, but the finite
case in this module has few dependencies.

A description of this formalization is in [Gusakov2021].

## Main statements

* `finset.all_card_le_bUnion_card_iff_exists_injective'` is Hall's theorem with
  a finite index set.  This is elsewhere generalized to
  `finset.all_card_le_bUnion_card_iff_exists_injective`.

## Tags

Hall's Marriage Theorem, indexed families
-/

open Finset

universe u v

namespace HallMarriageTheorem

variable {ι : Type u} {α : Type v} [DecidableEq α] {t : ι → Finset α}

section Fintype

variable [Fintype ι]

#print HallMarriageTheorem.hall_cond_of_erase /-
theorem hall_cond_of_erase {x : ι} (a : α)
    (ha : ∀ s : Finset ι, s.Nonempty → s ≠ univ → s.card < (s.bunionᵢ t).card)
    (s' : Finset { x' : ι | x' ≠ x }) : s'.card ≤ (s'.bunionᵢ fun x' => (t x').eraseₓ a).card :=
  by
  haveI := Classical.decEq ι
  specialize ha (s'.image coe)
  rw [nonempty.image_iff, Finset.card_image_of_injective s' Subtype.coe_injective] at ha
  by_cases he : s'.nonempty
  · have ha' : s'.card < (s'.bUnion fun x => t x).card :=
      by
      convert ha he fun h => by simpa [← h] using mem_univ x using 2
      ext x
      simp only [mem_image, mem_bUnion, exists_prop, SetCoe.exists, exists_and_right,
        exists_eq_right, Subtype.coe_mk]
    rw [← erase_bUnion]
    by_cases hb : a ∈ s'.bUnion fun x => t x
    · rw [card_erase_of_mem hb]
      exact Nat.le_pred_of_lt ha'
    · rw [erase_eq_of_not_mem hb]
      exact Nat.le_of_lt ha'
  · rw [nonempty_iff_ne_empty, Classical.not_not] at he
    subst s'
    simp
#align hall_marriage_theorem.hall_cond_of_erase HallMarriageTheorem.hall_cond_of_erase
-/

#print HallMarriageTheorem.hall_hard_inductive_step_A /-
/-- First case of the inductive step: assuming that
`∀ (s : finset ι), s.nonempty → s ≠ univ → s.card < (s.bUnion t).card`
and that the statement of **Hall's Marriage Theorem** is true for all
`ι'` of cardinality ≤ `n`, then it is true for `ι` of cardinality `n + 1`.
-/
theorem hall_hard_inductive_step_A {n : ℕ} (hn : Fintype.card ι = n + 1)
    (ht : ∀ s : Finset ι, s.card ≤ (s.bunionᵢ t).card)
    (ih :
      ∀ {ι' : Type u} [Fintype ι'] (t' : ι' → Finset α),
        Fintype.card ι' ≤ n →
          (∀ s' : Finset ι', s'.card ≤ (s'.bunionᵢ t').card) →
            ∃ f : ι' → α, Function.Injective f ∧ ∀ x, f x ∈ t' x)
    (ha : ∀ s : Finset ι, s.Nonempty → s ≠ univ → s.card < (s.bunionᵢ t).card) :
    ∃ f : ι → α, Function.Injective f ∧ ∀ x, f x ∈ t x :=
  by
  haveI : Nonempty ι := fintype.card_pos_iff.mp (hn.symm ▸ Nat.succ_pos _)
  haveI := Classical.decEq ι
  -- Choose an arbitrary element `x : ι` and `y : t x`.
  let x := Classical.arbitrary ι
  have tx_ne : (t x).Nonempty := by
    rw [← Finset.card_pos]
    calc
      0 < 1 := Nat.one_pos
      _ ≤ (Finset.bunionᵢ {x} t).card := (ht {x})
      _ = (t x).card := by rw [Finset.singleton_bunionᵢ]

  choose y hy using tx_ne
  -- Restrict to everything except `x` and `y`.
  let ι' := { x' : ι | x' ≠ x }
  let t' : ι' → Finset α := fun x' => (t x').eraseₓ y
  have card_ι' : Fintype.card ι' = n :=
    calc
      Fintype.card ι' = Fintype.card ι - 1 := Set.card_ne_eq _
      _ = n := by rw [hn, Nat.add_succ_sub_one, add_zero]

  rcases ih t' card_ι'.le (hall_cond_of_erase y ha) with ⟨f', hfinj, hfr⟩
  -- Extend the resulting function.
  refine' ⟨fun z => if h : z = x then y else f' ⟨z, h⟩, _, _⟩
  · rintro z₁ z₂
    have key : ∀ {x}, y ≠ f' x := by
      intro x h
      simpa [← h] using hfr x
    by_cases h₁ : z₁ = x <;> by_cases h₂ : z₂ = x <;> simp [h₁, h₂, hfinj.eq_iff, key, key.symm]
  · intro z
    split_ifs with hz
    · rwa [hz]
    · specialize hfr ⟨z, hz⟩
      rw [mem_erase] at hfr
      exact hfr.2
#align hall_marriage_theorem.hall_hard_inductive_step_A HallMarriageTheorem.hall_hard_inductive_step_A
-/

#print HallMarriageTheorem.hall_cond_of_restrict /-
theorem hall_cond_of_restrict {ι : Type u} {t : ι → Finset α} {s : Finset ι}
    (ht : ∀ s : Finset ι, s.card ≤ (s.bunionᵢ t).card) (s' : Finset (s : Set ι)) :
    s'.card ≤ (s'.bunionᵢ fun a' => t a').card := by
  classical
    rw [← card_image_of_injective s' Subtype.coe_injective]
    convert ht (s'.image coe) using 1
    apply congr_arg
    ext y
    simp
#align hall_marriage_theorem.hall_cond_of_restrict HallMarriageTheorem.hall_cond_of_restrict
-/

/- warning: hall_marriage_theorem.hall_cond_of_compl -> HallMarriageTheorem.hall_cond_of_compl is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u2}} [_inst_1 : DecidableEq.{succ u2} α] {ι : Type.{u1}} {t : ι -> (Finset.{u2} α)} {s : Finset.{u1} ι}, (Eq.{1} Nat (Finset.card.{u1} ι s) (Finset.card.{u2} α (Finset.bunionᵢ.{u1, u2} ι α (fun (a : α) (b : α) => _inst_1 a b) s t))) -> (forall (s : Finset.{u1} ι), LE.le.{0} Nat Nat.hasLe (Finset.card.{u1} ι s) (Finset.card.{u2} α (Finset.bunionᵢ.{u1, u2} ι α (fun (a : α) (b : α) => _inst_1 a b) s t))) -> (forall (s' : Finset.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} ι) Type.{u1} (Set.hasCoeToSort.{u1} ι) (HasCompl.compl.{u1} (Set.{u1} ι) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} ι) (Set.booleanAlgebra.{u1} ι)) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Finset.{u1} ι) (Set.{u1} ι) (HasLiftT.mk.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (CoeTCₓ.coe.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (Finset.Set.hasCoeT.{u1} ι))) s)))), LE.le.{0} Nat Nat.hasLe (Finset.card.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} ι) Type.{u1} (Set.hasCoeToSort.{u1} ι) (HasCompl.compl.{u1} (Set.{u1} ι) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} ι) (Set.booleanAlgebra.{u1} ι)) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Finset.{u1} ι) (Set.{u1} ι) (HasLiftT.mk.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (CoeTCₓ.coe.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (Finset.Set.hasCoeT.{u1} ι))) s))) s') (Finset.card.{u2} α (Finset.bunionᵢ.{u1, u2} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} ι) Type.{u1} (Set.hasCoeToSort.{u1} ι) (HasCompl.compl.{u1} (Set.{u1} ι) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} ι) (Set.booleanAlgebra.{u1} ι)) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Finset.{u1} ι) (Set.{u1} ι) (HasLiftT.mk.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (CoeTCₓ.coe.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (Finset.Set.hasCoeT.{u1} ι))) s))) α (fun (a : α) (b : α) => _inst_1 a b) s' (fun (x' : coeSort.{succ u1, succ (succ u1)} (Set.{u1} ι) Type.{u1} (Set.hasCoeToSort.{u1} ι) (HasCompl.compl.{u1} (Set.{u1} ι) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} ι) (Set.booleanAlgebra.{u1} ι)) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Finset.{u1} ι) (Set.{u1} ι) (HasLiftT.mk.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (CoeTCₓ.coe.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (Finset.Set.hasCoeT.{u1} ι))) s))) => SDiff.sdiff.{u2} (Finset.{u2} α) (Finset.hasSdiff.{u2} α (fun (a : α) (b : α) => _inst_1 a b)) (t ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} ι) Type.{u1} (Set.hasCoeToSort.{u1} ι) (HasCompl.compl.{u1} (Set.{u1} ι) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} ι) (Set.booleanAlgebra.{u1} ι)) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Finset.{u1} ι) (Set.{u1} ι) (HasLiftT.mk.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (CoeTCₓ.coe.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (Finset.Set.hasCoeT.{u1} ι))) s))) ι (HasLiftT.mk.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} ι) Type.{u1} (Set.hasCoeToSort.{u1} ι) (HasCompl.compl.{u1} (Set.{u1} ι) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} ι) (Set.booleanAlgebra.{u1} ι)) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Finset.{u1} ι) (Set.{u1} ι) (HasLiftT.mk.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (CoeTCₓ.coe.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (Finset.Set.hasCoeT.{u1} ι))) s))) ι (CoeTCₓ.coe.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} ι) Type.{u1} (Set.hasCoeToSort.{u1} ι) (HasCompl.compl.{u1} (Set.{u1} ι) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} ι) (Set.booleanAlgebra.{u1} ι)) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Finset.{u1} ι) (Set.{u1} ι) (HasLiftT.mk.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (CoeTCₓ.coe.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (Finset.Set.hasCoeT.{u1} ι))) s))) ι (coeBase.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} ι) Type.{u1} (Set.hasCoeToSort.{u1} ι) (HasCompl.compl.{u1} (Set.{u1} ι) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} ι) (Set.booleanAlgebra.{u1} ι)) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Finset.{u1} ι) (Set.{u1} ι) (HasLiftT.mk.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (CoeTCₓ.coe.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (Finset.Set.hasCoeT.{u1} ι))) s))) ι (coeSubtype.{succ u1} ι (fun (x : ι) => Membership.Mem.{u1, u1} ι (Set.{u1} ι) (Set.hasMem.{u1} ι) x (HasCompl.compl.{u1} (Set.{u1} ι) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} ι) (Set.booleanAlgebra.{u1} ι)) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Finset.{u1} ι) (Set.{u1} ι) (HasLiftT.mk.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (CoeTCₓ.coe.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (Finset.Set.hasCoeT.{u1} ι))) s))))))) x')) (Finset.bunionᵢ.{u1, u2} ι α (fun (a : α) (b : α) => _inst_1 a b) s t)))))
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : DecidableEq.{succ u2} α] {ι : Type.{u1}} {t : ι -> (Finset.{u2} α)} {s : Finset.{u1} ι}, (Eq.{1} Nat (Finset.card.{u1} ι s) (Finset.card.{u2} α (Finset.bunionᵢ.{u1, u2} ι α (fun (a : α) (b : α) => _inst_1 a b) s t))) -> (forall (s : Finset.{u1} ι), LE.le.{0} Nat instLENat (Finset.card.{u1} ι s) (Finset.card.{u2} α (Finset.bunionᵢ.{u1, u2} ι α (fun (a : α) (b : α) => _inst_1 a b) s t))) -> (forall (s' : Finset.{u1} (Set.Elem.{u1} ι (HasCompl.compl.{u1} (Set.{u1} ι) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} ι) (Set.instBooleanAlgebraSet.{u1} ι)) (Finset.toSet.{u1} ι s)))), LE.le.{0} Nat instLENat (Finset.card.{u1} (Set.Elem.{u1} ι (HasCompl.compl.{u1} (Set.{u1} ι) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} ι) (Set.instBooleanAlgebraSet.{u1} ι)) (Finset.toSet.{u1} ι s))) s') (Finset.card.{u2} α (Finset.bunionᵢ.{u1, u2} (Set.Elem.{u1} ι (HasCompl.compl.{u1} (Set.{u1} ι) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} ι) (Set.instBooleanAlgebraSet.{u1} ι)) (Finset.toSet.{u1} ι s))) α (fun (a : α) (b : α) => _inst_1 a b) s' (fun (x' : Set.Elem.{u1} ι (HasCompl.compl.{u1} (Set.{u1} ι) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} ι) (Set.instBooleanAlgebraSet.{u1} ι)) (Finset.toSet.{u1} ι s))) => SDiff.sdiff.{u2} (Finset.{u2} α) (Finset.instSDiffFinset.{u2} α (fun (a : α) (b : α) => _inst_1 a b)) (t (Subtype.val.{succ u1} ι (fun (x : ι) => Membership.mem.{u1, u1} ι (Set.{u1} ι) (Set.instMembershipSet.{u1} ι) x (HasCompl.compl.{u1} (Set.{u1} ι) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} ι) (Set.instBooleanAlgebraSet.{u1} ι)) (Finset.toSet.{u1} ι s))) x')) (Finset.bunionᵢ.{u1, u2} ι α (fun (a : α) (b : α) => _inst_1 a b) s t)))))
Case conversion may be inaccurate. Consider using '#align hall_marriage_theorem.hall_cond_of_compl HallMarriageTheorem.hall_cond_of_complₓ'. -/
theorem hall_cond_of_compl {ι : Type u} {t : ι → Finset α} {s : Finset ι}
    (hus : s.card = (s.bunionᵢ t).card) (ht : ∀ s : Finset ι, s.card ≤ (s.bunionᵢ t).card)
    (s' : Finset (sᶜ : Set ι)) : s'.card ≤ (s'.bunionᵢ fun x' => t x' \ s.bunionᵢ t).card :=
  by
  haveI := Classical.decEq ι
  have disj : Disjoint s (s'.image coe) :=
    by
    simp only [disjoint_left, not_exists, mem_image, exists_prop, SetCoe.exists, exists_and_right,
      exists_eq_right, Subtype.coe_mk]
    intro x hx hc h
    exact absurd hx hc
  have : s'.card = (s ∪ s'.image coe).card - s.card := by
    simp [disj, card_image_of_injective _ Subtype.coe_injective]
  rw [this, hus]
  refine' (tsub_le_tsub_right (ht _) _).trans _
  rw [← card_sdiff]
  · refine' (card_le_of_subset _).trans le_rfl
    intro t
    simp only [mem_bUnion, mem_sdiff, not_exists, mem_image, and_imp, mem_union, exists_and_right,
      exists_imp]
    rintro x (hx | ⟨x', hx', rfl⟩) rat hs
    · exact (hs x hx Rat).elim
    · exact ⟨⟨x', hx', Rat⟩, hs⟩
  · apply bUnion_subset_bUnion_of_subset_left
    apply subset_union_left
#align hall_marriage_theorem.hall_cond_of_compl HallMarriageTheorem.hall_cond_of_compl

#print HallMarriageTheorem.hall_hard_inductive_step_B /-
/-- Second case of the inductive step: assuming that
`∃ (s : finset ι), s ≠ univ → s.card = (s.bUnion t).card`
and that the statement of **Hall's Marriage Theorem** is true for all
`ι'` of cardinality ≤ `n`, then it is true for `ι` of cardinality `n + 1`.
-/
theorem hall_hard_inductive_step_B {n : ℕ} (hn : Fintype.card ι = n + 1)
    (ht : ∀ s : Finset ι, s.card ≤ (s.bunionᵢ t).card)
    (ih :
      ∀ {ι' : Type u} [Fintype ι'] (t' : ι' → Finset α),
        Fintype.card ι' ≤ n →
          (∀ s' : Finset ι', s'.card ≤ (s'.bunionᵢ t').card) →
            ∃ f : ι' → α, Function.Injective f ∧ ∀ x, f x ∈ t' x)
    (s : Finset ι) (hs : s.Nonempty) (hns : s ≠ univ) (hus : s.card = (s.bunionᵢ t).card) :
    ∃ f : ι → α, Function.Injective f ∧ ∀ x, f x ∈ t x :=
  by
  haveI := Classical.decEq ι
  -- Restrict to `s`
  let t' : s → Finset α := fun x' => t x'
  rw [Nat.add_one] at hn
  have card_ι'_le : Fintype.card s ≤ n :=
    by
    apply Nat.le_of_lt_succ
    calc
      Fintype.card s = s.card := Fintype.card_coe _
      _ < Fintype.card ι := ((card_lt_iff_ne_univ _).mpr hns)
      _ = n.succ := hn

  rcases ih t' card_ι'_le (hall_cond_of_restrict ht) with ⟨f', hf', hsf'⟩
  -- Restrict to `sᶜ` in the domain and `(s.bUnion t)ᶜ` in the codomain.
  set ι'' := (s : Set ι)ᶜ with ι''_def
  let t'' : ι'' → Finset α := fun a'' => t a'' \ s.bUnion t
  have card_ι''_le : Fintype.card ι'' ≤ n :=
    by
    simp_rw [← Nat.lt_succ_iff, ← hn, ι'', ← Finset.coe_compl, coe_sort_coe]
    rwa [Fintype.card_coe, card_compl_lt_iff_nonempty]
  rcases ih t'' card_ι''_le (hall_cond_of_compl hus ht) with ⟨f'', hf'', hsf''⟩
  -- Put them together
  have f'_mem_bUnion : ∀ {x'} (hx' : x' ∈ s), f' ⟨x', hx'⟩ ∈ s.bUnion t :=
    by
    intro x' hx'
    rw [mem_bUnion]
    exact ⟨x', hx', hsf' _⟩
  have f''_not_mem_bUnion : ∀ {x''} (hx'' : ¬x'' ∈ s), ¬f'' ⟨x'', hx''⟩ ∈ s.bUnion t :=
    by
    intro x'' hx''
    have h := hsf'' ⟨x'', hx''⟩
    rw [mem_sdiff] at h
    exact h.2
  have im_disj : ∀ (x' x'' : ι) (hx' : x' ∈ s) (hx'' : ¬x'' ∈ s), f' ⟨x', hx'⟩ ≠ f'' ⟨x'', hx''⟩ :=
    by
    intro _ _ hx' hx'' h
    apply f''_not_mem_bUnion hx''
    rw [← h]
    apply f'_mem_bUnion
  refine' ⟨fun x => if h : x ∈ s then f' ⟨x, h⟩ else f'' ⟨x, h⟩, _, _⟩
  · exact hf'.dite _ hf'' im_disj
  · intro x
    split_ifs with h
    · exact hsf' ⟨x, h⟩
    · exact sdiff_subset _ _ (hsf'' ⟨x, h⟩)
#align hall_marriage_theorem.hall_hard_inductive_step_B HallMarriageTheorem.hall_hard_inductive_step_B
-/

end Fintype

variable [Finite ι]

#print HallMarriageTheorem.hall_hard_inductive /-
/-- Here we combine the two inductive steps into a full strong induction proof,
completing the proof the harder direction of **Hall's Marriage Theorem**.
-/
theorem hall_hard_inductive (ht : ∀ s : Finset ι, s.card ≤ (s.bunionᵢ t).card) :
    ∃ f : ι → α, Function.Injective f ∧ ∀ x, f x ∈ t x :=
  by
  cases nonempty_fintype ι
  induction' hn : Fintype.card ι using Nat.strong_induction_on with n ih generalizing ι
  rcases n with (_ | _)
  · rw [Fintype.card_eq_zero_iff] at hn
    exact ⟨isEmptyElim, isEmptyElim, isEmptyElim⟩
  · have ih' :
      ∀ (ι' : Type u) [Fintype ι'] (t' : ι' → Finset α),
        Fintype.card ι' ≤ n →
          (∀ s' : Finset ι', s'.card ≤ (s'.bunionᵢ t').card) →
            ∃ f : ι' → α, Function.Injective f ∧ ∀ x, f x ∈ t' x :=
      by
      intro ι' _ _ hι' ht'
      exact ih _ (Nat.lt_succ_of_le hι') ht' _ rfl
    by_cases h : ∀ s : Finset ι, s.Nonempty → s ≠ univ → s.card < (s.bunionᵢ t).card
    · exact hall_hard_inductive_step_A hn ht ih' h
    · push_neg  at h
      rcases h with ⟨s, sne, snu, sle⟩
      exact hall_hard_inductive_step_B hn ht ih' s sne snu (Nat.le_antisymm (ht _) sle)
#align hall_marriage_theorem.hall_hard_inductive HallMarriageTheorem.hall_hard_inductive
-/

end HallMarriageTheorem

/- warning: finset.all_card_le_bUnion_card_iff_exists_injective' -> Finset.all_card_le_bunionᵢ_card_iff_existsInjective' is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : Type.{u2}} [_inst_1 : Finite.{succ u1} ι] [_inst_2 : DecidableEq.{succ u2} α] (t : ι -> (Finset.{u2} α)), Iff (forall (s : Finset.{u1} ι), LE.le.{0} Nat Nat.hasLe (Finset.card.{u1} ι s) (Finset.card.{u2} α (Finset.bunionᵢ.{u1, u2} ι α (fun (a : α) (b : α) => _inst_2 a b) s t))) (Exists.{max (succ u1) (succ u2)} (ι -> α) (fun (f : ι -> α) => And (Function.Injective.{succ u1, succ u2} ι α f) (forall (x : ι), Membership.Mem.{u2, u2} α (Finset.{u2} α) (Finset.hasMem.{u2} α) (f x) (t x))))
but is expected to have type
  forall {ι : Type.{u2}} {α : Type.{u1}} [_inst_1 : Finite.{succ u2} ι] [_inst_2 : DecidableEq.{succ u1} α] (t : ι -> (Finset.{u1} α)), Iff (forall (s : Finset.{u2} ι), LE.le.{0} Nat instLENat (Finset.card.{u2} ι s) (Finset.card.{u1} α (Finset.bunionᵢ.{u2, u1} ι α (fun (a : α) (b : α) => _inst_2 a b) s t))) (Exists.{max (succ u2) (succ u1)} (ι -> α) (fun (f : ι -> α) => And (Function.Injective.{succ u2, succ u1} ι α f) (forall (x : ι), Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) (f x) (t x))))
Case conversion may be inaccurate. Consider using '#align finset.all_card_le_bUnion_card_iff_exists_injective' Finset.all_card_le_bunionᵢ_card_iff_existsInjective'ₓ'. -/
/-- This is the version of **Hall's Marriage Theorem** in terms of indexed
families of finite sets `t : ι → finset α` with `ι` finite.
It states that there is a set of distinct representatives if and only
if every union of `k` of the sets has at least `k` elements.

See `finset.all_card_le_bUnion_card_iff_exists_injective` for a version
where the `finite ι` constraint is removed.
-/
theorem Finset.all_card_le_bunionᵢ_card_iff_existsInjective' {ι α : Type _} [Finite ι]
    [DecidableEq α] (t : ι → Finset α) :
    (∀ s : Finset ι, s.card ≤ (s.bunionᵢ t).card) ↔
      ∃ f : ι → α, Function.Injective f ∧ ∀ x, f x ∈ t x :=
  by
  constructor
  · exact HallMarriageTheorem.hall_hard_inductive
  · rintro ⟨f, hf₁, hf₂⟩ s
    rw [← card_image_of_injective s hf₁]
    apply card_le_of_subset
    intro
    rw [mem_image, mem_bUnion]
    rintro ⟨x, hx, rfl⟩
    exact ⟨x, hx, hf₂ x⟩
#align finset.all_card_le_bUnion_card_iff_exists_injective' Finset.all_card_le_bunionᵢ_card_iff_existsInjective'


/-
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 Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.algebra.continuous_functions
import Mathlib.linear_algebra.affine_space.affine_map
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# 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.
-/

namespace affine_map

/-
TODO: Deal with the case where the point spaces are different from the vector spaces.
-/

/-- An affine map is continuous iff its underlying linear map is continuous. -/
theorem continuous_iff {R : Type u_1} {E : Type u_2} {F : Type u_3} [ring R] [add_comm_group E] [semimodule R E] [topological_space E] [add_comm_group F] [semimodule R F] [topological_space F] [topological_add_group F] {f : affine_map R E F} : continuous ⇑f ↔ continuous ⇑(linear f) := sorry

/-- The line map is continuous. -/
theorem line_map_continuous {R : Type u_1} {F : Type u_3} [ring R] [add_comm_group F] [semimodule R F] [topological_space F] [topological_add_group F] [topological_space R] [topological_semimodule R F] {p : F} {v : F} : continuous ⇑(line_map p v) :=
  iff.mpr continuous_iff (continuous.add (continuous.smul continuous_id continuous_const) continuous_const)


--  An abstract formalization of "isomorphism is equality up to relabeling"
-- -------------------------------------------------------------------------
--
-- See `README.md` for more info.
--
-- As a prerequisite for `AbstractBuildingBlocks.lean`, here we define generalized versions of Π and Σ
-- expressions, where all involved types are replaced by structures and all dependencies are functors.

import Structure.Basic
import Structure.Forgetfulness
import Structure.UniverseFunctor
import Structure.FunctorStructure

open Morphisms
open HasStructure
open Structure
open Pi
open StructureFunctor
open Forgetfulness
open SetoidStructureFunctor

set_option autoBoundImplicitLocal false

-- TODO: Can we avoid this?
set_option maxHeartbeats 200000

universes u v

namespace PiSigma

-- First, we define a "structure dependency" that holds the information contained in a Π or Σ type:
-- A structure (representing the type on the left-hand side) and a functor that returns a structure
-- (representing the dependent type on the right-hand side).

structure StructureDependency where
(S : Structure)
(F : UniverseFunctor S)

namespace StructureDependency

def constDep (S T : Structure) : StructureDependency := ⟨S, constFun T⟩

structure StructureDependencyEquiv (C D : StructureDependency) where
(e : C.S ≃ D.S)
-- TODO: Why does `≃` not work here? There is some strange type class resolution issue with the `universeFunctor` argument at play.
(η : FunctorEquiv C.F (D.F ⊙ e.toFun))

namespace StructureDependencyEquiv

def invFunEquiv {C D : StructureDependency} (φ : StructureDependencyEquiv C D) : FunctorEquiv (C.F ⊙ φ.e.invFun) D.F :=
let e₁ := FunctorEquiv.trans (compFun.congrArg_left (F := φ.e.invFun) φ.η) (compFun.congrArg_right (G := D.F) φ.e.isInv.rightInv);
FunctorEquiv.trans e₁ (idFun.rightId D.F)

def refl  (C     : StructureDependency)                                                                       : StructureDependencyEquiv C C :=
⟨StructureEquiv.refl  C.S,     FunctorEquiv.symm (idFun.rightId C.F)⟩

def symm  {C D   : StructureDependency} (φ : StructureDependencyEquiv C D)                                    : StructureDependencyEquiv D C :=
⟨StructureEquiv.symm  φ.e,     FunctorEquiv.symm (invFunEquiv φ)⟩

def trans {C D E : StructureDependency} (φ : StructureDependencyEquiv C D) (ψ : StructureDependencyEquiv D E) : StructureDependencyEquiv C E :=
⟨StructureEquiv.trans φ.e ψ.e, FunctorEquiv.trans φ.η (compFun.congrArg_left (F := φ.e.toFun) ψ.η)⟩

def StructureDependencyEquivEquiv {C D : StructureDependency} (φ ψ : StructureDependencyEquiv C D) :=
Σ' ζ : φ.e ≃ ψ.e, compFun.congrArg_right (G := D.F) ζ.toFunEquiv • φ.η ≈ ψ.η

namespace StructureDependencyEquivEquiv

variable {C D : StructureDependency}

def refl  (φ     : StructureDependencyEquiv C D)                                                                                : StructureDependencyEquivEquiv φ φ :=
⟨StructureEquiv.EquivEquiv.refl  φ.e,
 leftCancelId (compFun.congrArg_right.respectsId φ.e.toFun)⟩

def symm  {φ ψ   : StructureDependencyEquiv C D} (ζ : StructureDependencyEquivEquiv φ ψ)                                         : StructureDependencyEquivEquiv ψ φ :=
⟨StructureEquiv.EquivEquiv.symm  ζ.fst,
 let h₁ := (leftMulInv (h := functorHasStructure) φ.η ψ.η (compFun.congrArg_right ζ.fst.toFunEquiv)).mp ζ.snd;
 let h₂ := compFun.congrArg_right.respectsInv ζ.fst.toFunEquiv;
 comp_subst_left h₂ (Setoid.symm h₁)⟩

def trans {φ ψ χ : StructureDependencyEquiv C D} (ζ : StructureDependencyEquivEquiv φ ψ) (ξ : StructureDependencyEquivEquiv ψ χ) : StructureDependencyEquivEquiv φ χ :=
⟨StructureEquiv.EquivEquiv.trans ζ.fst ξ.fst,
 let h₁ := applyAssoc_left (comp_subst_right ζ.snd ξ.snd);
 let h₂ := compFun.congrArg_right.respectsComp ζ.fst.toFunEquiv ξ.fst.toFunEquiv;
 comp_subst_left h₂ h₁⟩

def StructureDependencyEquivEquivEquiv {φ ψ : StructureDependencyEquiv C D} (ζ ξ : StructureDependencyEquivEquiv φ ψ) :=
ζ.fst ≈ ξ.fst

namespace StructureDependencyEquivEquivEquiv

variable {φ ψ : StructureDependencyEquiv C D}

theorem refl  (ζ     : StructureDependencyEquivEquiv φ ψ)                                                                                : StructureDependencyEquivEquivEquiv ζ ζ :=
Setoid.refl  ζ.fst

theorem symm  {ζ ξ   : StructureDependencyEquivEquiv φ ψ} (h : StructureDependencyEquivEquivEquiv ζ ξ)                                              : StructureDependencyEquivEquivEquiv ξ ζ :=
Setoid.symm  h

theorem trans {ζ ξ σ : StructureDependencyEquivEquiv φ ψ} (h : StructureDependencyEquivEquivEquiv ζ ξ) (i : StructureDependencyEquivEquivEquiv ξ σ) : StructureDependencyEquivEquivEquiv ζ σ :=
Setoid.trans h i

instance structureDependencyEquivEquivSetoid : Setoid (StructureDependencyEquivEquiv φ ψ) := ⟨StructureDependencyEquivEquivEquiv, ⟨refl, symm, trans⟩⟩

end StructureDependencyEquivEquivEquiv

def structureDependencyEquivEquiv (φ ψ : StructureDependencyEquiv C D) : BundledSetoid := ⟨StructureDependencyEquivEquiv φ ψ⟩

-- TODO: Is there a less annoying way to do this?
def comp_congrArg {φ ψ χ : StructureDependencyEquiv C D}
                  {ζ₁ ζ₂ : StructureDependencyEquivEquiv φ ψ}     {ξ₁ ξ₂ : StructureDependencyEquivEquiv ψ χ}
                  (hζ : StructureDependencyEquivEquivEquiv ζ₁ ζ₂) (hξ : StructureDependencyEquivEquivEquiv ξ₁ ξ₂) :
  StructureDependencyEquivEquivEquiv (trans ζ₁ ξ₁) (trans ζ₂ ξ₂) :=
HasStructure.comp_congrArg hζ hξ

instance structureDependencyEquivEquivHasIso : HasIsomorphisms (@structureDependencyEquivEquiv C D) :=
{ refl          := refl,
  symm          := symm,
  trans         := trans,
  comp_congrArg := comp_congrArg,
  inv_congrArg  := sorry,
  assoc         := λ ζ ξ σ => sorry,
  leftId        := λ ζ     => sorry,
  rightId       := λ ζ     => sorry,
  leftInv       := λ ζ     => sorry,
  rightInv      := λ ζ     => sorry,
  invInv        := λ ζ     => sorry,
  compInv       := λ ζ ξ   => sorry,
  idInv         := λ φ     => sorry }

end StructureDependencyEquivEquiv

instance structureDependencyEquivHasStructure (C D : StructureDependency) : HasStructure (StructureDependencyEquiv C D) :=
⟨StructureDependencyEquivEquiv.structureDependencyEquivEquiv⟩

def structureDependencyEquivStructure (C D : StructureDependency) : Structure := ⟨StructureDependencyEquiv C D⟩

instance structureDependencyEquivSetoid (C D : StructureDependency) : Setoid (StructureDependencyEquiv C D) := structureToSetoid (structureDependencyEquivStructure C D)

def structureDependencyEquiv (C D : StructureDependency) : BundledSetoid := ⟨StructureDependencyEquiv C D⟩

instance structureDependencyEquivHasIso : HasIsomorphisms structureDependencyEquiv :=
{ refl          := refl,
  symm          := symm,
  trans         := trans,
  comp_congrArg := λ hφ hψ => sorry,
  inv_congrArg  := λ hφ    => sorry,
  assoc         := λ φ ψ χ => sorry,
  leftId        := λ φ     => sorry,
  rightId       := λ φ     => sorry,
  leftInv       := λ φ     => sorry,
  rightInv      := λ φ     => sorry,
  invInv        := λ φ     => sorry,
  compInv       := λ φ ψ   => sorry,
  idInv         := λ C     => sorry }

end StructureDependencyEquiv

instance structureDependencyHasStructure : HasStructure StructureDependency := ⟨StructureDependencyEquiv.structureDependencyEquiv⟩
def structureDependencyStructure : Structure := ⟨StructureDependency⟩

namespace structureDependencyStructure

-- We can construct a functor into `StructureDependency` by giving essentially a functor yielding `S` and
-- a Π expression yielding `F`.

structure StructureDependencyFunctorDesc where
(FS                                                                 : UniverseStructureFunctor)
(FF                 (S   : Structure)                               : UniverseFunctor (FS.map S))
(mapEquiv           {S T : Structure} (e : S ≃ T)                   : FunctorEquiv (FF S) (FF T ⊙ (FS.mapEquiv e).toFun))
(respectsEquivEquiv {S T : Structure} {e₁ e₂ : S ≃ T} (η : e₁ ≃ e₂) : compFun.congrArg_right (G := FF T) (FS.respectsEquiv η).toFunEquiv • mapEquiv e₁ ≈ mapEquiv e₂)

variable (D : StructureDependencyFunctorDesc)

def structureDependency (S : Structure) : StructureDependency := ⟨D.FS S, D.FF S⟩

def mkFunctor_equiv {S T : Structure} (e : S ≃ T) :
  structureDependency D S ≃ structureDependency D T :=
⟨D.FS.mapEquiv e, D.mapEquiv e⟩

def mkFunctor_respectsEquiv {S T : Structure} {e₁ e₂ : S ≃ T} (η : e₁ ≃ e₂) :
  StructureDependencyEquiv.StructureDependencyEquivEquiv (mkFunctor_equiv D e₁) (mkFunctor_equiv D e₂) :=
⟨D.FS.respectsEquiv η, D.respectsEquivEquiv η⟩

def mkFunctor_respectsComp {S T U : Structure} (e : S ≃ T) (f : T ≃ U) :
  StructureDependencyEquiv.StructureDependencyEquivEquiv (mkFunctor_equiv D (f • e)) (mkFunctor_equiv D f • mkFunctor_equiv D e) :=
⟨D.FS.respectsComp e f, sorry⟩

def mkFunctor : StructureFunctor universeStructure structureDependencyStructure :=
{ map     := structureDependency D,
  functor := { mapEquiv  := mkFunctor_equiv D,
               isFunctor := { respectsEquiv := λ ⟨η⟩ => ⟨mkFunctor_respectsEquiv D η⟩,
                              respectsComp  := λ e f => ⟨mkFunctor_respectsComp D e f⟩,
                              respectsId    := sorry,
                              respectsInv   := sorry } } }

end structureDependencyStructure

def setoidMap (C : StructureDependency) := setoidStructure ∘ C.F.map

end StructureDependency

open StructureDependency

-- A structure that represents a functorial version of the type `∀ a : C.S, C.F a`.
--
-- Since `C.F` is a functor, `e : a ≃ b` induces an `e' : C.F a ≃ C.F b`. We then require an
-- `F : PiExpr C` to produce an instance equivalence between `F a : C.F a` and `F b : C.F b`.
-- As a special case, if `C.F` is constant, this ensures that `F` is a functor.
--
-- Since equivalence of equivalences in `C.S` is just a proposition, we cannot meaningfully compare two
-- results of `mapEquiv` even if the inputs are equivalent: For `h : e₁ ≈ e₂`, we would need something
-- along the lines of `mapEquiv e₁ ≈[respectsSetoid C.F h] mapEquiv e₂`, but such an expression only makes
-- sense with an object inside the brackets, not with a proof.
-- Therefore, we include a setoid truncation in `mapEquiv` so that its result is just a proof.

structure PiExpr (C : StructureDependency) where
(map                              : Pi (setoidMap C))
(mapEquiv {a b : C.S} (e : a ≃ b) : map a ≈[congrArg C.F e] map b)

namespace PiExpr

instance (C : StructureDependency) : CoeFun (PiExpr C) (λ _ => ∀ a : C.S, C.F a) := ⟨PiExpr.map⟩

def congrArg {C : StructureDependency} (F : PiExpr C) {a b : C.S} (e : a ≃ b) : F a ≈[congrArg C.F e] F b :=
F.mapEquiv e

def PiEquiv {C : StructureDependency} (F G : PiExpr C) := Pi.PiEquiv.MappedPiEquiv PiExpr.map F G

namespace PiEquiv

variable {C : StructureDependency}

def refl  (F     : PiExpr C)                                     : PiEquiv F F :=
Pi.PiEquiv.MappedPiEquiv.refl  F
def symm  {F G   : PiExpr C} (η : PiEquiv F G)                   : PiEquiv G F :=
Pi.PiEquiv.MappedPiEquiv.symm  η
def trans {F G H : PiExpr C} (η : PiEquiv F G) (θ : PiEquiv G H) : PiEquiv F H :=
Pi.PiEquiv.MappedPiEquiv.trans η θ

def piEquiv : RelationWithSetoid (PiExpr C) := Pi.PiEquiv.MappedPiEquiv.mappedPiEquiv (m := PiExpr.map)

instance piEquivHasIso : HasIsomorphisms (@piEquiv C) := Pi.PiEquiv.MappedPiEquiv.mappedPiEquivHasIso

end PiEquiv

instance piHasStructure (C : StructureDependency) : HasStructure (PiExpr C) := ⟨PiEquiv.piEquiv⟩
def piStructure (C : StructureDependency) : Structure := ⟨PiExpr C⟩

def idPi {S : Structure} : PiExpr (StructureDependency.constDep S S) :=
{ map      := id,
  mapEquiv := structureSetoidEquiv S }

def compFunPi {S : Structure} {C : StructureDependency} (F : StructureFunctor S C.S) (G : PiExpr C) :
  PiExpr ⟨S, C.F ⊙ F⟩ :=
{ map      := λ a => G (F a),
  mapEquiv := λ e => congrArg G (StructureFunctor.congrArg F e) }

def constPiToFun {S T : Structure} (F : PiExpr (StructureDependency.constDep S T)) :
  StructureFunctor S (setoidStructure T) :=
makeToSetoidStructureFunctor F.map F.mapEquiv

def funToConstPi {S T : Structure} (F : StructureFunctor S (setoidStructure T)) :
  PiExpr (StructureDependency.constDep S T) :=
{ map      := F.map,
  mapEquiv := F.functor.mapEquiv }

def transportPi {C D : StructureDependency} (φ : StructureDependencyEquiv C D) :
  PiExpr C → PiExpr D :=
let θ := StructureDependencyEquiv.invFunEquiv φ;
λ G => { map      := λ a => (θ.ext a).toFun (G (φ.e.invFun a)),
         mapEquiv := λ {a b} e => let ⟨n⟩ := θ.nat e;
                                  let ⟨m⟩ := congrArg G (StructureFunctor.congrArg φ.e.invFun e);
                                  ⟨HasTrans.trans (n.toFunEquiv.ext (G (φ.e.invFun a))) (StructureFunctor.congrArg (θ.ext b).toFun m)⟩ }

def dependentApplicationFunctor {S T : Structure} {F : UniverseFunctor S}
                                (G : PiExpr ⟨S, functorStructure.incomingFunctorFunctor T ⊙ F⟩)
                                (x : PiExpr ⟨S, F⟩) :
  SetoidStructureFunctor S T :=
makeSetoidStructureFunctor (λ a => (G a).map (x a))
                           (λ {a b} ⟨e⟩ => let ⟨h₁⟩ := congrArg G e;
                                           let ⟨h₂⟩ := congrArg x e;
                                           let h₃ := StructureFunctor.congr h₁ h₂;
                                           let h₄ := StructureFunctor.congrArg (G a) ((StructureFunctor.congrArg F e).isInv.leftInv.ext (x a));
                                           ⟨HasTrans.trans (HasSymm.symm h₄) h₃⟩)

namespace piStructure

instance (C : StructureDependency) : CoeFun (IsType.type (piStructure C)) (λ _ => ∀ a : C.S, C.F a) := ⟨PiExpr.map⟩

-- An independent `PiExpr` is the same as a functor (to a setoid structure).

section constDep

variable (S T : Structure)

@[reducible] def constDepPi  := piStructure (StructureDependency.constDep S T)
@[reducible] def constDepFun := functorStructure S (setoidStructure T)

def constDepToFun : StructureFunctor (constDepPi S T) (constDepFun S T) :=
{ map     := constPiToFun,
  functor := { mapEquiv  := λ η => makeToSetoidStructureFunctorEquiv' η,
               isFunctor := { respectsEquiv := id,
                              respectsComp  := λ η θ => Setoid.refl (θ • η),
                              respectsId    := λ F   => Setoid.refl (id__ F),
                              respectsInv   := λ η   => Setoid.refl η⁻¹ } } }

def constDepInvFun : StructureFunctor (constDepFun S T) (constDepPi S T) :=
{ map     := funToConstPi,
  functor := { mapEquiv  := λ η => η.ext,
               isFunctor := { respectsEquiv := id,
                              respectsComp  := λ η θ => Setoid.refl (θ • η),
                              respectsId    := λ F   => Setoid.refl (id__ F),
                              respectsInv   := λ η   => Setoid.refl η⁻¹ } } }

def constDepEquiv : StructureEquiv (constDepPi S T) (constDepFun S T) :=
{ toFun    := constDepToFun  S T,
  invFun   := constDepInvFun S T,
  isInv  := { leftInv  := { ext := λ F a => HasRefl.refl (F a),
                            nat := λ _ _ => proofIrrel _ _ },
              rightInv := { ext := λ F => makeToSetoidStructureFunctorEquiv' (λ a => HasRefl.refl (F a)),
                            nat := λ _ _ => proofIrrel _ _ },
              lrCompat := λ _ _ => proofIrrel _ _,
              rlCompat := λ _ _ => proofIrrel _ _ } }

end constDep

-- If we fix the argument, we obtain a functor from `piStructure` to the result type.

def projFunctor (C : StructureDependency) (a : C.S) : StructureFunctor (piStructure C) (setoidStructure (C.F a)) :=
{ map     := λ F => F a,
  functor := { mapEquiv  := λ η => η a,
               isFunctor := { respectsEquiv := λ h   => h a,
                              respectsComp  := λ η θ => Setoid.refl (θ a • η a),
                              respectsId    := λ F   => Setoid.refl (id_ (F a)),
                              respectsInv   := λ η   => Setoid.refl (η a)⁻¹ } } }

-- `piStructure` itself can be viewed as a dependent structure, depending on an instance of
-- `StructureDependency`.

-- TODO: Why does `C ≃ D` not work?
def piStructureFunctor_toFun {C D : StructureDependency} (φ : StructureDependencyEquiv C D) :
  StructureFunctor (piStructure C) (piStructure D) :=
let θ := StructureDependencyEquiv.invFunEquiv φ;
{ map     := transportPi φ,
  functor := { mapEquiv  := λ η a => StructureFunctor.congrArg (setoidFunctor (θ.ext a).toFun) (η (φ.e.invFun a)),
               isFunctor := { respectsEquiv := λ _ _   => proofIrrel _ _,
                              respectsComp  := λ _ _ _ => proofIrrel _ _,
                              respectsId    := λ _   _ => proofIrrel _ _,
                              respectsInv   := λ _   _ => proofIrrel _ _ } } }

def piStructureFunctor_equiv {C D : StructureDependency} (φ : StructureDependencyEquiv C D) :
  piStructure C ≃ piStructure D :=
{ toFun  := piStructureFunctor_toFun φ,
  invFun := piStructureFunctor_toFun (StructureDependencyEquiv.symm φ),
  isInv  := sorry }

def piStructureFunctor : UniverseFunctor structureDependencyStructure :=
{ map     := piStructure,
  functor := { mapEquiv  := piStructureFunctor_equiv,
               isFunctor := sorry } }

def piStructureDependency : StructureDependency := ⟨structureDependencyStructure, piStructureFunctor⟩

def piStructureMkFunctor (D : structureDependencyStructure.StructureDependencyFunctorDesc) :
  UniverseStructureFunctor :=
{ map           := λ S => piStructure (structureDependencyStructure.structureDependency D S),
  mapEquiv      := λ e => piStructureFunctor_equiv (structureDependencyStructure.mkFunctor_equiv D e),
  respectsEquiv := sorry,
  respectsComp  := sorry,
  respectsId    := sorry,
  respectsInv   := sorry }

end piStructure

end PiExpr

open PiExpr

-- A Σ expression of structures.

def SigmaExpr (C : StructureDependency) := Σ' a : C.S, IsType.type (setoidMap C a)

namespace SigmaExpr

-- The equivalence between encoded Σ expressions is actually the generalized version of the example
-- in the introduction: A bundled instance of a Lean type class is an instance of the corresponding
-- Σ type. If the type class is a functor, we can define two bundled instances to be isomorphic iff
-- we have an equivalence `e` between the types such that `congrArg C.F e` maps one
-- instance of the type class to the other.

def SigmaEquiv {C : StructureDependency} (P Q : SigmaExpr C) :=
Σ' e : P.fst ≃ Q.fst, P.snd ≈[congrArg C.F e] Q.snd

namespace SigmaEquiv

variable {C : StructureDependency}

def refl  (P     : SigmaExpr C)                                           : SigmaEquiv P P :=
let h₁ := SetoidInstanceEquiv.refl (C.F P.fst) P.snd;
let h₂ := Setoid.symm (respectsId   C.F P.fst);
⟨HasRefl.refl   P.fst,       SetoidInstanceEquiv.mapEquiv h₂ P.snd P.snd h₁⟩

def symm  {P Q   : SigmaExpr C} (e : SigmaEquiv P Q)                      : SigmaEquiv Q P :=
let h₁ := SetoidInstanceEquiv.symm (congrArg C.F e.fst) P.snd Q.snd e.snd;
let h₂ := Setoid.symm (respectsInv  C.F e.fst);
⟨HasSymm.symm   e.fst,       SetoidInstanceEquiv.mapEquiv h₂ Q.snd P.snd h₁⟩

def trans {P Q R : SigmaExpr C} (e : SigmaEquiv P Q) (f : SigmaEquiv Q R) : SigmaEquiv P R :=
let h₁ := SetoidInstanceEquiv.trans (congrArg C.F e.fst) (congrArg C.F f.fst) P.snd Q.snd R.snd e.snd f.snd;
let h₂ := Setoid.symm (respectsComp C.F e.fst f.fst);
⟨HasTrans.trans e.fst f.fst, SetoidInstanceEquiv.mapEquiv h₂ P.snd R.snd h₁⟩

-- No need to compare `e.snd` and `f.snd` because they are proofs.
def SigmaEquivEquiv {P Q : SigmaExpr C} (e f : SigmaEquiv P Q) := e.fst ≈ f.fst

namespace SigmaEquivEquiv

variable {P Q : SigmaExpr C}

theorem refl  (e     : SigmaEquiv P Q)                                                     : SigmaEquivEquiv e e :=
Setoid.refl  e.fst

theorem symm  {e f   : SigmaEquiv P Q} (h : SigmaEquivEquiv e f)                           : SigmaEquivEquiv f e :=
Setoid.symm  h

theorem trans {e f g : SigmaEquiv P Q} (h : SigmaEquivEquiv e f) (i : SigmaEquivEquiv f g) : SigmaEquivEquiv e g :=
Setoid.trans h i

instance sigmaEquivSetoid : Setoid (SigmaEquiv P Q) := ⟨SigmaEquivEquiv, ⟨refl, symm, trans⟩⟩

end SigmaEquivEquiv

def sigmaEquiv (P Q : SigmaExpr C) : BundledSetoid := ⟨SigmaEquiv P Q⟩

instance sigmaEquivHasIso : HasIsomorphisms (@sigmaEquiv C) :=
{ refl          := refl,
  symm          := symm,
  trans         := trans,
  comp_congrArg := λ he hf => comp_congrArg he hf,
  inv_congrArg  := λ he    => inv_congrArg  he,
  assoc         := λ e f g => assoc         e.fst f.fst g.fst,
  leftId        := λ e     => leftId        e.fst,
  rightId       := λ e     => rightId       e.fst,
  leftInv       := λ e     => leftInv       e.fst,
  rightInv      := λ e     => rightInv      e.fst,
  invInv        := λ e     => invInv        e.fst,
  compInv       := λ e f   => compInv       e.fst f.fst,
  idInv         := λ s     => idInv         s.fst }

end SigmaEquiv

instance sigmaHasStructure (C : StructureDependency) : HasStructure (SigmaExpr C) := ⟨SigmaEquiv.sigmaEquiv⟩
def sigmaStructure (C : StructureDependency) : Structure := ⟨SigmaExpr C⟩

def transportSigma {C D : StructureDependency} (φ : StructureDependencyEquiv C D) :
  SigmaExpr C → SigmaExpr D :=
λ s => ⟨φ.e.toFun s.fst, (φ.η.ext s.fst).toFun s.snd⟩

namespace sigmaStructure

-- Introduction and projections of `sigmaStructure` are functorial.

section MkProj

variable (C : StructureDependency)

def mkSndFunctor : UniverseFunctor C.S :=
functorStructure.incomingFunctorFunctor (sigmaStructure C) ⊙ C.F

def mkDependency : StructureDependency := ⟨C.S, mkSndFunctor C⟩

def mkExprFunctor (a : C.S) : StructureFunctor (C.F a) (sigmaStructure C) :=
{ map     := λ b => ⟨a, b⟩,
  functor := { mapEquiv  := λ {b c} e => ⟨id_ a, SetoidInstanceEquiv.mapEquiv (Setoid.symm (respectsId C.F a)) b c ⟨e⟩⟩,
               isFunctor := { respectsEquiv := λ _   => Setoid.refl _,
                              respectsComp  := λ _ _ => Setoid.symm (leftId _),
                              respectsId    := λ _   => Setoid.refl (id'' (S := sigmaStructure C)),
                              respectsInv   := λ _   => Setoid.symm (idInv _) } } }

theorem mkExprCongrArg {a₁ a₂ : C.S} (e : a₁ ≃ a₂) :
  mkExprFunctor C a₁ ≈[congrArg (mkSndFunctor C) e] mkExprFunctor C a₂ :=
⟨{ ext := λ b       => ⟨e, ⟨(StructureFunctor.congrArg C.F e).isInv.rightInv.ext b⟩⟩,
   nat := λ {b c} ε => sorry }⟩

def mkExpr : PiExpr (mkDependency C) := ⟨mkExprFunctor C, mkExprCongrArg C⟩

def mkFunctor {S : Structure} (mkFst : StructureFunctor S C.S) (mkSnd : PiExpr ⟨S, C.F ⊙ mkFst⟩) :
  SetoidStructureFunctor S (sigmaStructure C) :=
let F : PiExpr ⟨S, mkSndFunctor C ⊙ mkFst⟩ := compFunPi (C := mkDependency C) mkFst (mkExpr C);
dependentApplicationFunctor F mkSnd

def projFstFunctor : StructureFunctor (sigmaStructure C) C.S :=
{ map     := PSigma.fst,
  functor := { mapEquiv  := PSigma.fst,
               isFunctor := { respectsEquiv := id,
                              respectsComp  := λ e f => Setoid.refl (f • e),
                              respectsId    := λ a   => Setoid.refl (id__ a),
                              respectsInv   := λ e   => Setoid.refl e⁻¹ } } }

def projSndDependencyFunctor : UniverseFunctor (sigmaStructure C) :=
C.F ⊙ projFstFunctor C

def projSndDependency : StructureDependency := ⟨sigmaStructure C, projSndDependencyFunctor C⟩

def projSndExpr : PiExpr (projSndDependency C) := ⟨PSigma.snd, PSigma.snd⟩

-- TODO: Show that a sigma structure with `constDep` is the same as a binary product.

end MkProj

-- `sigmaStructure` itself can be viewed as dependent structures, depending on an instance of
-- `StructureDependency`.

theorem transportSnd {C D : StructureDependency} (φ : StructureDependencyEquiv C D)
                     {s t : SigmaExpr C} (e : SigmaEquiv s t) :
  (φ.η.ext s.fst).toFun s.snd ≈[congrArg (D.F ⊙ φ.e.toFun) e.fst] (φ.η.ext t.fst).toFun t.snd :=
let ⟨f⟩ := φ.η.nat e.fst;
let h₁ := ⟨f.toFunEquiv.ext s.snd⟩;
let h₂ := StructureFunctor.congrArg (setoidFunctor (φ.η.ext t.fst).toFun) e.snd;
Setoid.trans h₁ h₂

-- TODO: Why does `C ≃ D` not work?
def sigmaStructureFunctor_toFun {C D : StructureDependency} (φ : StructureDependencyEquiv C D) :
  StructureFunctor (sigmaStructure C) (sigmaStructure D) :=
{ map     := transportSigma φ,
  functor := { mapEquiv  := λ {s t} e => ⟨congrArg φ.e.toFun e.fst, transportSnd φ e⟩,
               isFunctor := { respectsEquiv := λ h   => respectsSetoid φ.e.toFun h,
                              respectsComp  := λ e f => respectsComp   φ.e.toFun e.fst f.fst,
                              respectsId    := λ s   => respectsId     φ.e.toFun s.fst,
                              respectsInv   := λ e   => respectsInv    φ.e.toFun e.fst } } }

def sigmaStructureFunctor_equiv {C D : StructureDependency} (φ : StructureDependencyEquiv C D) :
  sigmaStructure C ≃ sigmaStructure D :=
{ toFun  := sigmaStructureFunctor_toFun φ,
  invFun := sigmaStructureFunctor_toFun (StructureDependencyEquiv.symm φ),
  isInv  := sorry }

def sigmaStructureFunctor : UniverseFunctor structureDependencyStructure :=
{ map     := sigmaStructure,
  functor := { mapEquiv  := sigmaStructureFunctor_equiv,
               isFunctor := sorry } }

def sigmaStructureDependency : StructureDependency := ⟨structureDependencyStructure, sigmaStructureFunctor⟩

end sigmaStructure

end SigmaExpr

open SigmaExpr

-- TODO: Define richer Π and Σ structures where the left side is a structure.
-- Looks like we need `nestedPiFunctor` to be a `UniverseStructureFunctor` then. Is it possible?

-- Analogously to the equivalences in `ProductStructure.lean`, we have equivalences between dependent
-- structures. However, since the left side of a dependent structure always requires more data than
-- the right side, we need to restrict ourselves to the case that the first variable is a structure,
-- the second variable is any instance of any structure, and the third argument is an instance of a
-- setoid structure.
--
-- TODO: We may be able to give a somewhat general definition of the word "canonical" based on these
-- equivalences.

namespace PiSigmaEquivalences

section InnerPair

variable (F : UniverseStructureFunctor)

def innerPairStructure := sigmaStructure ⟨universeStructure, UniverseStructureFunctor.universeFunctor F⟩

-- `b ↦ ⟨A, b⟩`
def innerPairFunctor (A : Structure) : StructureFunctor (F A) (innerPairStructure F) :=
sigmaStructure.mkExprFunctor ⟨universeStructure, UniverseStructureFunctor.universeFunctor F⟩ A

end InnerPair

def NestedDependency := Σ' F : UniverseStructureFunctor, UniverseFunctor (innerPairStructure F)

variable (D : NestedDependency)

def innerPairDependency : StructureDependency := ⟨innerPairStructure D.fst, D.snd⟩

-- `b ↦ D.snd ⟨A, b⟩`
def resultFunctor (A : Structure) : UniverseFunctor (D.fst A) :=
D.snd ⊙ innerPairFunctor D.fst A

-- `A ↦ (b ↦ D.snd ⟨A, b⟩)`
def innerDependencyFunctorDesc : structureDependencyStructure.StructureDependencyFunctorDesc :=
{ FS                 := D.fst,
  FF                 := resultFunctor D,
  mapEquiv           := sorry,
  respectsEquivEquiv := sorry }

def innerDependencyFunctor : StructureFunctor universeStructure structureDependencyStructure :=
StructureDependency.structureDependencyStructure.mkFunctor (innerDependencyFunctorDesc D)

-- `(∀ A : Structure, ∀ b : F A, G A b) ≃ (∀ ⟨A, b⟩ : (Σ A : Structure, F A), G A b)`
-- (`(λ A b => g A b) ↦ (λ ⟨A, b⟩ => g A b)`)

-- `A ↦ ∀ b : D.fst A, D.snd ⟨A, b⟩`
def nestedPiFunctor : UniverseFunctor universeStructure := piStructure.piStructureFunctor ⊙ innerDependencyFunctor D
def nestedPiDependency : StructureDependency := ⟨universeStructure, nestedPiFunctor D⟩

@[reducible] def piPiCurried   := piStructure (nestedPiDependency  D)
@[reducible] def piPiUncurried := piStructure (innerPairDependency D)

def piPiEquivToFun  : StructureFunctor (piPiCurried   D) (piPiUncurried D) :=
{ map     := λ g => ⟨λ ⟨a, b⟩ => (g a).map b, sorry⟩,
  functor := sorry }

def piPiEquivInvFun : StructureFunctor (piPiUncurried D) (piPiCurried   D) :=
{ map     := λ g => ⟨λ a => ⟨λ b => g ⟨a, b⟩, sorry⟩, sorry⟩,
  functor := sorry }

def piPiEquiv : StructureEquiv (piPiCurried D) (piPiUncurried D) :=
{ toFun  := piPiEquivToFun  D,
  invFun := piPiEquivInvFun D,
  isInv  := sorry }

-- `(Σ A : Structure, Σ b : F A, G A b) ≃ (Σ ⟨A, b⟩ : (Σ A : Structure, F A), G A b)`
-- (`⟨A, ⟨b, c⟩⟩ ↦ ⟨⟨A, b⟩, c⟩`)

-- `A ↦ Σ b : D.fst A, D.snd ⟨A, b⟩`
def nestedSigmaFunctor : UniverseFunctor universeStructure := sigmaStructure.sigmaStructureFunctor ⊙ innerDependencyFunctor D
def nestedSigmaDependency : StructureDependency := ⟨universeStructure, nestedSigmaFunctor D⟩

def sigmaSigmaCurried   := sigmaStructure (nestedSigmaDependency D)
def sigmaSigmaUncurried := sigmaStructure (innerPairDependency   D)

def sigmaSigmaEquivToFun  : StructureFunctor (sigmaSigmaCurried   D) (sigmaSigmaUncurried D) :=
{ map     := λ ⟨A, ⟨b, c⟩⟩ => ⟨⟨A, b⟩, c⟩,
  functor := { mapEquiv  := λ ⟨e, he⟩ => sorry,
               isFunctor := { respectsEquiv := sorry,
                              respectsComp  := sorry,
                              respectsId    := sorry,
                              respectsInv   := sorry } } }

def sigmaSigmaEquivInvFun : StructureFunctor (sigmaSigmaUncurried D) (sigmaSigmaCurried   D) :=
{ map     := λ ⟨⟨A, b⟩, c⟩ => ⟨A, ⟨b, c⟩⟩,
  functor := { mapEquiv  := λ ⟨⟨e, f⟩, g⟩ => sorry,
               isFunctor := { respectsEquiv := sorry,
                              respectsComp  := sorry,
                              respectsId    := sorry,
                              respectsInv   := sorry } } }

def sigmaSigmaEquiv : StructureEquiv (sigmaSigmaCurried D) (sigmaSigmaUncurried D) :=
{ toFun  := sigmaSigmaEquivToFun  D,
  invFun := sigmaSigmaEquivInvFun D,
  isInv  := sorry }

-- `(∀ A : Structure, Σ b : F A, G A b) ≃ (Σ f : (∀ A : Structure, F A), ∀ A : Structure, G A (f A))`
-- (`(λ A => ⟨f A, g A (f A)⟩ ↦ ⟨λ A => f A, λ A => g A (f A)⟩`)

-- TODO

end PiSigmaEquivalences

end PiSigma


universe u

namespace field

structure q (α : Type u) [integral_domain α] := (n : α) (d : α ) (nz : d ≠ 0)
lemma q.ext {α : Type u} [integral_domain α] : Π (q1 q2 : q α), q1.n = q2.n → q1.d = q2.d → q1 = q2
|⟨n,d,nz⟩ ⟨_,_,_⟩ rfl rfl := rfl

instance (α : Type u) [integral_domain α] : setoid (q α) :=
{ r := (λ a b, a.1 * b.2 = b.1 * a.2)
, iseqv :=
  ⟨ λ a, rfl
  , λ a b p, eq.symm p
  , λ ⟨n₁,d₁,_⟩ ⟨n₂,d₂,h⟩ ⟨n₃,d₃,_⟩ (p : n₁ * d₂ = n₂ * d₁) (q : n₂ * d₃ = n₃ * d₂),
    suffices d₂ * (n₁ * d₃) = d₂ * (n₃ * d₁), from eq_of_mul_eq_mul_left h this,
    calc
      d₂ * (n₁ * d₃) = (n₁ * d₂) * d₃ : by ac_refl
                ...  = (n₂ * d₁) * d₃ : by rw p
                ...  = (n₂ * d₃) * d₁ : by ac_refl
                ...  = (n₃ * d₂) * d₁ : by rw q
                ...  = d₂ * (n₃ * d₁) : by ac_refl
  ⟩
}

def setoid.restrict {α : Type u} (s : setoid α) (P : set α) : setoid ({a:α // a ∈ P}) :=
{ r := λ a₁ a₂, @setoid.r α s a₁ a₂
, iseqv :=
  let ⟨r,y,t⟩ := setoid.iseqv α in
  ⟨λ a, r _,λ a₁ a₂ q, y q, λ a1 a2 a3 q p, t q p⟩
}
section restrict
variables {α β : Type u} [s : setoid α] {P : set α}
def quotient.restrict (P : set α) := @quotient _ (setoid.restrict s P)
def quotient.mk_restrict (a : α) (aP : a ∈ P) : @quotient.restrict α s P := @quotient.mk _ (setoid.restrict s P) ⟨a,aP⟩
def quotient.restrict_sound (a b : α) (aP : a ∈ P) (bP : b ∈ P) (h : @setoid.r α s a b) : quotient.mk_restrict a aP = quotient.mk_restrict b bP :=
begin apply quotient.sound, apply h end
def quotient.restrict_lift_on (q : quotient.restrict P) (f : Π (a:α), a ∈ P → β)
  (p : ∀ a b (aP : a ∈ P) (bP : b ∈ P), a ≈ b → f a aP = f b bP) : β :=
  @quotient.lift_on _ β (setoid.restrict s P) q (λ ⟨x,xP⟩, f x xP) (λ ⟨a,aP⟩ ⟨b,bP⟩ r, p a b aP bP r)
lemma quotient.lift_beta [setoid α] (f : α → β) (p : _) (q:α) : quotient.lift f p (quotient.mk q) = f q
:= begin simp [quotient.lift], apply quot.lift_beta, apply p end
end restrict
def free (α : Type u) [integral_domain α] : Type* := @quotient (q α) (by apply_instance)
variables {α : Type u} [integral_domain α]
namespace free

def mul_neq_zero (a b : α) (anz : a ≠ 0) (bnz : b ≠ 0) : a * b ≠ 0 :=
λ mz, have o : _, from integral_domain.eq_zero_or_eq_zero_of_mul_eq_zero a b mz, or.rec_on o anz bnz

def add : free α → free α → free α
:= λ x y, quotient.lift_on₂ x y
  (λ x y, ⟦(⟨x.1 * y.2 + y.1 * x.2, x.2 * y.2, mul_ne_zero x.nz y.nz⟩ : q α)⟧)
  (λ a1 a2 b1 b2,
      assume p : a1.1 * b1.2 = b1.1 * a1.2,
      assume q : a2.1 * b2.2 = b2.1 * a2.2,
      suffices (a1.1 * a2.2 + a2.1 * a1.2) * (b1.2 * b2.2) = (b1.1 * b2.2 + b2.1 * b1.2) * (a1.2 * a2.2),
        from quotient.sound this,
      calc ((a1.1 * a2.2) + (a2.1 * a1.2)) * (b1.2 * b2.2) = ((a1.1 * a2.2) * (b1.2 * b2.2) + (a2.1 * a1.2) * (b1.2 * b2.2)) : by apply integral_domain.right_distrib
                                                  ...  = ((a1.1 * b1.2) * (a2.2 * b2.2) + (b1.2 * a1.2) * (a2.1 * b2.2)) : by ac_refl
                                                  ...  = ((b1.1 * a1.2) * (a2.2 * b2.2) + (b1.2 * a1.2) * (b2.1 * a2.2)) : by rw p; rw q
                                                  ...  = (((b1.1 * b2.2)* (a1.2 * a2.2)) + ((b2.1 * b1.2) * (a1.2 * a2.2)))   : by ac_refl
                                                  ...  = (b1.1 * b2.2 + b2.1 * b1.2) * (a1.2 * a2.2)                     : by apply eq.symm; apply integral_domain.right_distrib
  )

def neg : free α → free α
:= λ x, quotient.lift_on x (λ x, ⟦(⟨-x.1,x.2,x.nz⟩ : q α)⟧)
  (λ a b,
    assume r : a.1 * b.2 = b.1 * a.2,
    suffices (-a.1) * b.2 = (- b.1)* a.2, from quotient.sound this,
    by simp [r]
  )
instance : has_neg (free α) := ⟨neg⟩

instance : has_add (free α) := ⟨λ a b , add a b⟩
def prod.ext {α β : Type u} : Π (p q : α × β) (l : p.1 = q.1) (r : p.2 = q.2), p = q
|⟨p1,p2⟩ ⟨q1,q2⟩ rfl rfl := rfl

--
lemma add_assoc (A B C : free α) : (A + B) + C = A + (B + C) :=
begin
  apply quotient.induction_on A,
  apply quotient.induction_on B,
  apply quotient.induction_on C,
  intros a b c,
  apply quot.sound, simp [setoid.r],
  show (a.n * (c.d * b.d) + (b.n * c.d + c.n * b.d) * a.d) * ((c.d) * ((b.d) * (a.d)))
       = (c.n * (b.d * a.d) + (a.n * b.d + b.n * a.d) * c.d) * ((c.d * b.d) * a.d),
  repeat {rw [integral_domain.right_distrib]},
  generalize ah₁ : (a.n * (c.d * b.d) * (c.d * (b.d * a.d))) = a₁,
  generalize ah₂: a.n * b.d * c.d * (c.d * b.d * a.d) = a₂,
  generalize bh₁: b.n * c.d * a.d * (c.d * (b.d * a.d)) = b₁,
  generalize bh₂: b.n * a.d * c.d * (c.d * b.d * a.d) = b₂,
  generalize ch₁: c.n * b.d * a.d * (c.d * (b.d * a.d)) = c₁,
  generalize ch₂: c.n * (b.d * a.d) * (c.d * b.d * a.d) = c₂,
  have p : a₁ = a₂, by rw [<-ah₁, <-ah₂]; ac_refl,
  have q : b₁ = b₂, by rw [<-bh₁, <-bh₂]; ac_refl,
  have r : c₁ = c₂, by rw [<-ch₁, <-ch₂]; ac_refl,
  rw [p,q,r],
  ac_refl
end

def pure : α → free α := λ a, ⟦⟨a,1,one_ne_zero⟩⟧
def zero : free α := free.pure 0
def one : free α := free.pure 1

lemma zero_add (A : free α) : free.zero + A = A :=
begin
  apply quotient.induction_on A,
  intros a,
  apply quot.sound,
  simp [setoid.r],
end

lemma add_comm (A B : free α) : A + B = B + A :=
begin
  apply quotient.induction_on₂ A B, intros a b, apply quot.sound, simp [setoid.r],
  repeat {rw [integral_domain.right_distrib]},
  cc
end

lemma add_zero (A : free α) : A + free.zero = A := by rw [add_comm]; apply zero_add

def nonzero (α : Type*) [integral_domain α] := quotient.restrict ({x: q α| x.1 ≠ 0})

def inv_guard (x: nonzero α) : free α
:= quotient.restrict_lift_on x
  (λ p nez, quotient.mk $ ⟨p.2,p.1,nez⟩)
  (λ a b az bz,
    assume r : a.1 * b.2 = b.1 * a.2,
    quotient.sound $
    show a.d * (b.n) = b.d * a.n, from begin apply eq.symm, rw [integral_domain.mul_comm, r], ac_refl  end
  )

def mul : free α → free α → free α
:= λ x y, quotient.lift_on₂ x y
  (λ x y, ⟦(⟨x.1 * y.1, x.2 * y.2, mul_ne_zero x.nz y.nz⟩ : q α)⟧)
  (λ a1 a2 b1 b2,
      assume p : a1.1 * b1.2 = b1.1 * a1.2,
      assume q : a2.1 * b2.2 = b2.1 * a2.2,
      suffices (a1.1 * a2.1) * (b1.2 * b2.2) = (b1.1* b2.1) * (a1.2 * a2.2),
        from quotient.sound this,
      calc (a1.1 * a2.1) * (b1.2 * b2.2) = (a1.1 * b1.2) * (a2.1 * b2.2) : by ac_refl
           ... = (b1.1 * a1.2) * (b2.1 * a2.2) : by rw [p,q]
           ... = (b1.1* b2.1) * (a1.2 * a2.2) : by ac_refl
  )
instance : has_mul (free α) := ⟨mul⟩
def mul_comm (A B : free α) : A * B = B * A :=
begin
  apply quotient.induction_on₂ A B, intros a b, apply quot.sound, simp [setoid.r], ac_refl
end
def mul_assoc (A B C : free α) : (A * B )* C = A * (B * C) :=
begin
  apply quotient.induction_on₂ A B, intros a b, apply quotient.induction_on C, intro c, apply quot.sound, simp [setoid.r], ac_refl
end
#check field.add_left_neg
lemma add_left_neg (A : free α) : (-A) + A = free.zero := begin
  apply quotient.induction_on A, intros a, apply quot.sound, simp [setoid.r],
  repeat {rw [integral_domain.right_distrib]},
  end

  lemma add_right_neg (A : free α) : (A) + (-A) = free.zero := begin
  apply quotient.induction_on A, intros a, apply quot.sound, simp [setoid.r],
  repeat {rw [integral_domain.right_distrib]},
  end

lemma one_mul (A : free α) : free.one * A = A := begin
  apply quotient.induction_on A, intros a, apply quot.sound, simp [setoid.r],
end
lemma mul_one (A : free α) :  A * free.one = A := begin
  apply quotient.induction_on A, intros a, apply quot.sound, simp [setoid.r],
end

#check congr_arg
def congr_arg2 {α β γ : Type*} {f : α → β → γ} : ∀ {a₁ a₂ : α} {b₁ b₂ : β} , (a₁ = a₂) → (b₁ = b₂) → f a₁ b₁ = f a₂ b₂
|_ _ _ _ rfl rfl := rfl

lemma right_distrib (A B C : free α) : (A + B) * C = A * C + B * C :=
begin
  apply quotient.induction_on A,
  apply quotient.induction_on B,
  apply quotient.induction_on C,
  intros a b c,
  apply quot.sound, simp [setoid.r],
  repeat {rw [integral_domain.right_distrib]},
  --rw [integral_domain.add_comm],
  apply congr_arg2,
  ac_refl,
ac_refl
end

#eval 1 + 2

lemma left_distrib (A B C : free α) : A * ( B + C) = A * B + A * C :=
begin
  apply quotient.induction_on A,
  apply quotient.induction_on B,
  apply quotient.induction_on C,
  intros a b c,
  apply quot.sound, simp [setoid.r],
  repeat {rw [integral_domain.right_distrib]},
  repeat {rw [integral_domain.left_distrib]},
  repeat {rw [integral_domain.right_distrib]},
  --rw [integral_domain.add_comm],
  apply congr_arg2,
  ac_refl, ac_refl
end

instance : comm_ring (free α) :=
{ zero := zero
, mul := mul
, add := add
, one := one
, neg := neg
, add_assoc := add_assoc
, zero_add := zero_add
, add_zero := add_zero
, add_comm := add_comm
, mul_comm := mul_comm
, mul_assoc := mul_assoc
, add_left_neg := add_left_neg
, one_mul:=one_mul
, mul_one:=mul_one
, right_distrib:=right_distrib
, left_distrib:=left_distrib
}

-- -- def add : free α → free α → free α
-- -- |⟦⟨a,b⟩⟧ ⟦⟨x,y⟩⟧ := ⟦⟨a * y + x * b, b * y⟩⟧

-- -- [TODO] : prove it's a division ring
-- instance : division_ring (free α) := sorry
-- instance [comm_ring α] : field (free α) := sorry
-- -- instance [comm_ring α] [ordered_ring α] : ordered_field (free α) := sorry
-- -- [TODO] : the idea is to prove a chain of adjunctions, then show that division ring -> field is reflective.
-- -- lots of things lift in ways that I find interesting. Eg ring -> field lifts orderings.
-- -- [TODO] : write a functor (ordered field -> complete field)

-- -- I wonder if you do universal algebra first, you can get all of this structure for free?
end free
end field


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.type_tags
import Mathlib.algebra.group.units_hom
import Mathlib.algebra.ring.basic
import Mathlib.data.equiv.mul_add
import Mathlib.PostPort

universes u_1 u_2 l u v

namespace Mathlib

/-!
# Unbundled monoid and group homomorphisms (deprecated)

This file defines typeclasses for unbundled monoid and group homomorphisms. Though these classes are
deprecated, they are still widely used in mathlib, and probably will not go away before Lean 4
because Lean 3 often fails to coerce a bundled homomorphism to a function.

## main definitions

is_monoid_hom (deprecated), is_group_hom (deprecated)

## implementation notes

There's a coercion from bundled homs to fun, and the canonical
notation is to use the bundled hom as a function via this coercion.

There is no `group_hom` -- the idea is that `monoid_hom` is used.
The constructor for `monoid_hom` needs a proof of `map_one` as well
as `map_mul`; a separate constructor `monoid_hom.mk'` will construct
group homs (i.e. monoid homs between groups) given only a proof
that multiplication is preserved,

## Tags

is_group_hom, is_monoid_hom, monoid_hom

-/

/--
We have lemmas stating that the composition of two morphisms is again a morphism.
Since composition is reducible, type class inference will always succeed in applying these instances.
For example when the goal is just `⊢ is_mul_hom f` the instance `is_mul_hom.comp`
will still succeed, unifying `f` with `f ∘ (λ x, x)`.  This causes type class inference to loop.
To avoid this, we do not make these lemmas instances.
-/
/-- Predicate for maps which preserve an addition. -/
class is_add_hom {α : Type u_1} {β : Type u_2} [Add α] [Add β] (f : α → β)
where
  map_add : ∀ (x y : α), f (x + y) = f x + f y

/-- Predicate for maps which preserve a multiplication. -/
class is_mul_hom {α : Type u_1} {β : Type u_2} [Mul α] [Mul β] (f : α → β)
where
  map_mul : ∀ (x y : α), f (x * y) = f x * f y

namespace is_mul_hom

/-- The identity map preserves multiplication. -/
protected instance Mathlib.is_add_hom.id {α : Type u} [Add α] : is_add_hom id :=
  is_add_hom.mk fun (_x _x_1 : α) => rfl

/-- The composition of maps which preserve multiplication, also preserves multiplication. -/
-- see Note [no instance on morphisms]

theorem comp {α : Type u} {β : Type v} [Mul α] [Mul β] {γ : Type u_1} [Mul γ] (f : α → β) (g : β → γ) [is_mul_hom f] [hg : is_mul_hom g] : is_mul_hom (g ∘ f) := sorry

/-- A product of maps which preserve multiplication,
preserves multiplication when the target is commutative. -/
instance mul {α : Type u_1} {β : Type u_2} [semigroup α] [comm_semigroup β] (f : α → β) (g : α → β) [is_mul_hom f] [is_mul_hom g] : is_mul_hom fun (a : α) => f a * g a := sorry

/-- The inverse of a map which preserves multiplication,
preserves multiplication when the target is commutative. -/
instance inv {α : Type u_1} {β : Type u_2} [Mul α] [comm_group β] (f : α → β) [is_mul_hom f] : is_mul_hom fun (a : α) => f a⁻¹ :=
  mk fun (a b : α) => Eq.symm (map_mul f a b) ▸ mul_inv (f a) (f b)

end is_mul_hom

/-- Predicate for add_monoid homomorphisms (deprecated -- use the bundled `monoid_hom` version). -/
class is_add_monoid_hom {α : Type u} {β : Type v} [add_monoid α] [add_monoid β] (f : α → β)
extends is_add_hom f
where
  map_zero : f 0 = 0

/-- Predicate for monoid homomorphisms (deprecated -- use the bundled `monoid_hom` version). -/
class is_monoid_hom {α : Type u} {β : Type v} [monoid α] [monoid β] (f : α → β)
extends is_mul_hom f
where
  map_one : f 1 = 1

namespace monoid_hom

/-!
Throughout this section, some `monoid` arguments are specified with `{}` instead of `[]`.
See note [implicit instance arguments].
-/

/-- Interpret a map `f : M → N` as a homomorphism `M →* N`. -/
def Mathlib.add_monoid_hom.of {M : Type u_1} {N : Type u_2} [mM : add_monoid M] [mN : add_monoid N] (f : M → N) [h : is_add_monoid_hom f] : M →+ N :=
  add_monoid_hom.mk f (is_add_monoid_hom.map_zero f) sorry

@[simp] theorem Mathlib.add_monoid_hom.coe_of {M : Type u_1} {N : Type u_2} {mM : add_monoid M} {mN : add_monoid N} (f : M → N) [is_add_monoid_hom f] : ⇑(add_monoid_hom.of f) = f :=
  rfl

protected instance is_monoid_hom {M : Type u_1} {N : Type u_2} {mM : monoid M} {mN : monoid N} (f : M →* N) : is_monoid_hom ⇑f :=
  is_monoid_hom.mk (map_one f)

end monoid_hom

namespace mul_equiv

/-- A multiplicative isomorphism preserves multiplication (deprecated). -/
protected instance Mathlib.add_equiv.is_add_hom {M : Type u_1} {N : Type u_2} [add_monoid M] [add_monoid N] (h : M ≃+ N) : is_add_hom ⇑h :=
  is_add_hom.mk (add_equiv.map_add h)

/-- A multiplicative bijection between two monoids is a monoid hom
  (deprecated -- use to_monoid_hom). -/
protected instance Mathlib.add_equiv.is_add_monoid_hom {M : Type u_1} {N : Type u_2} [add_monoid M] [add_monoid N] (h : M ≃+ N) : is_add_monoid_hom ⇑h :=
  is_add_monoid_hom.mk (add_equiv.map_zero h)

end mul_equiv

namespace is_monoid_hom

/-- A monoid homomorphism preserves multiplication. -/
theorem Mathlib.is_add_monoid_hom.map_add {α : Type u} {β : Type v} [add_monoid α] [add_monoid β] (f : α → β) [is_add_monoid_hom f] (x : α) (y : α) : f (x + y) = f x + f y :=
  is_add_hom.map_add f x y

end is_monoid_hom

/-- A map to a group preserving multiplication is a monoid homomorphism. -/
theorem is_monoid_hom.of_mul {α : Type u} {β : Type v} [monoid α] [group β] (f : α → β) [is_mul_hom f] : is_monoid_hom f := sorry

namespace is_monoid_hom

/-- The identity map is a monoid homomorphism. -/
protected instance Mathlib.is_add_monoid_hom.id {α : Type u} [add_monoid α] : is_add_monoid_hom id :=
  is_add_monoid_hom.mk rfl

/-- The composite of two monoid homomorphisms is a monoid homomorphism. -/
theorem Mathlib.is_add_monoid_hom.comp {α : Type u} {β : Type v} [add_monoid α] [add_monoid β] (f : α → β) [is_add_monoid_hom f] {γ : Type u_1} [add_monoid γ] (g : β → γ) [is_add_monoid_hom g] : is_add_monoid_hom (g ∘ f) := sorry

end is_monoid_hom

namespace is_add_monoid_hom

/-- Left multiplication in a ring is an additive monoid morphism. -/
protected instance is_add_monoid_hom_mul_left {γ : Type u_1} [semiring γ] (x : γ) : is_add_monoid_hom fun (y : γ) => x * y :=
  mk (mul_zero x)

/-- Right multiplication in a ring is an additive monoid morphism. -/
protected instance is_add_monoid_hom_mul_right {γ : Type u_1} [semiring γ] (x : γ) : is_add_monoid_hom fun (y : γ) => y * x :=
  mk (zero_mul x)

end is_add_monoid_hom

/-- Predicate for additive group homomorphism (deprecated -- use bundled `monoid_hom`). -/
class is_add_group_hom {α : Type u} {β : Type v} [add_group α] [add_group β] (f : α → β)
extends is_add_hom f
where

/-- Predicate for group homomorphisms (deprecated -- use bundled `monoid_hom`). -/
class is_group_hom {α : Type u} {β : Type v} [group α] [group β] (f : α → β)
extends is_mul_hom f
where

protected instance monoid_hom.is_group_hom {G : Type u_1} {H : Type u_2} {_x : group G} : ∀ {_x_1 : group H} (f : G →* H), is_group_hom ⇑f :=
  fun (f : G →* H) => is_group_hom.mk

protected instance mul_equiv.is_group_hom {G : Type u_1} {H : Type u_2} {_x : group G} : ∀ {_x_1 : group H} (h : G ≃* H), is_group_hom ⇑h :=
  fun (h : G ≃* H) => is_group_hom.mk

/-- Construct `is_group_hom` from its only hypothesis. The default constructor tries to get
`is_mul_hom` from class instances, and this makes some proofs fail. -/
theorem is_group_hom.mk' {α : Type u} {β : Type v} [group α] [group β] {f : α → β} (hf : ∀ (x y : α), f (x * y) = f x * f y) : is_group_hom f :=
  is_group_hom.mk

namespace is_group_hom

/-- A group homomorphism is a monoid homomorphism. -/
protected instance Mathlib.is_add_group_hom.to_is_add_monoid_hom {α : Type u} {β : Type v} [add_group α] [add_group β] (f : α → β) [is_add_group_hom f] : is_add_monoid_hom f :=
  is_add_monoid_hom.of_add f

/-- A group homomorphism sends 1 to 1. -/
theorem map_one {α : Type u} {β : Type v} [group α] [group β] (f : α → β) [is_group_hom f] : f 1 = 1 :=
  is_monoid_hom.map_one f

/-- A group homomorphism sends inverses to inverses. -/
theorem Mathlib.is_add_group_hom.map_neg {α : Type u} {β : Type v} [add_group α] [add_group β] (f : α → β) [is_add_group_hom f] (a : α) : f (-a) = -f a := sorry

/-- The identity is a group homomorphism. -/
protected instance id {α : Type u} [group α] : is_group_hom id :=
  mk

/-- The composition of two group homomorphisms is a group homomorphism. -/
theorem comp {α : Type u} {β : Type v} [group α] [group β] (f : α → β) [is_group_hom f] {γ : Type u_1} [group γ] (g : β → γ) [is_group_hom g] : is_group_hom (g ∘ f) :=
  mk

/-- A group homomorphism is injective iff its kernel is trivial. -/
theorem Mathlib.is_add_group_hom.injective_iff {α : Type u} {β : Type v} [add_group α] [add_group β] (f : α → β) [is_add_group_hom f] : function.injective f ↔ ∀ (a : α), f a = 0 → a = 0 := sorry

/-- The product of group homomorphisms is a group homomorphism if the target is commutative. -/
instance Mathlib.is_add_group_hom.add {α : Type u_1} {β : Type u_2} [add_group α] [add_comm_group β] (f : α → β) (g : α → β) [is_add_group_hom f] [is_add_group_hom g] : is_add_group_hom fun (a : α) => f a + g a :=
  is_add_group_hom.mk

/-- The inverse of a group homomorphism is a group homomorphism if the target is commutative. -/
instance Mathlib.is_add_group_hom.neg {α : Type u_1} {β : Type u_2} [add_group α] [add_comm_group β] (f : α → β) [is_add_group_hom f] : is_add_group_hom fun (a : α) => -f a :=
  is_add_group_hom.mk

end is_group_hom

namespace ring_hom

/-!
These instances look redundant, because `deprecated.ring` provides `is_ring_hom` for a `→+*`.
Nevertheless these are harmless, and helpful for stripping out dependencies on `deprecated.ring`.
-/

protected instance is_monoid_hom {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R →+* S) : is_monoid_hom ⇑f :=
  is_monoid_hom.mk (map_one f)

protected instance is_add_monoid_hom {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R →+* S) : is_add_monoid_hom ⇑f :=
  is_add_monoid_hom.mk (map_zero f)

protected instance is_add_group_hom {R : Type u_1} {S : Type u_2} [ring R] [ring S] (f : R →+* S) : is_add_group_hom ⇑f :=
  is_add_group_hom.mk

end ring_hom

/-- Inversion is a group homomorphism if the group is commutative. -/
instance inv.is_group_hom {α : Type u} [comm_group α] : is_group_hom has_inv.inv :=
  is_group_hom.mk

namespace is_add_group_hom

/-- Additive group homomorphisms commute with subtraction. -/
theorem map_sub {α : Type u} {β : Type v} [add_group α] [add_group β] (f : α → β) [is_add_group_hom f] (a : α) (b : α) : f (a - b) = f a - f b := sorry

end is_add_group_hom

/-- The difference of two additive group homomorphisms is an additive group
homomorphism if the target is commutative. -/
instance is_add_group_hom.sub {α : Type u_1} {β : Type u_2} [add_group α] [add_comm_group β] (f : α → β) (g : α → β) [is_add_group_hom f] [is_add_group_hom g] : is_add_group_hom fun (a : α) => f a - g a := sorry

namespace units

/-- The group homomorphism on units induced by a multiplicative morphism. -/
def map' {M : Type u_1} {N : Type u_2} [monoid M] [monoid N] (f : M → N) [is_monoid_hom f] : units M →* units N :=
  map (monoid_hom.of f)

@[simp] theorem coe_map' {M : Type u_1} {N : Type u_2} [monoid M] [monoid N] (f : M → N) [is_monoid_hom f] (x : units M) : ↑(coe_fn (map' f) x) = f ↑x :=
  rfl

protected instance coe_is_monoid_hom {M : Type u_1} [monoid M] : is_monoid_hom coe :=
  monoid_hom.is_monoid_hom (coe_hom M)

end units

namespace is_unit

theorem map' {M : Type u_1} {N : Type u_2} [monoid M] [monoid N] (f : M → N) {x : M} (h : is_unit x) [is_monoid_hom f] : is_unit (f x) :=
  map (monoid_hom.of f) h

end is_unit

theorem additive.is_add_hom {α : Type u} {β : Type v} [Mul α] [Mul β] (f : α → β) [is_mul_hom f] : is_add_hom f :=
  is_add_hom.mk (is_mul_hom.map_mul f)

theorem multiplicative.is_mul_hom {α : Type u} {β : Type v} [Add α] [Add β] (f : α → β) [is_add_hom f] : is_mul_hom f :=
  is_mul_hom.mk (is_add_hom.map_add f)

theorem additive.is_add_monoid_hom {α : Type u} {β : Type v} [monoid α] [monoid β] (f : α → β) [is_monoid_hom f] : is_add_monoid_hom f :=
  is_add_monoid_hom.mk (is_monoid_hom.map_one f)

theorem multiplicative.is_monoid_hom {α : Type u} {β : Type v} [add_monoid α] [add_monoid β] (f : α → β) [is_add_monoid_hom f] : is_monoid_hom f :=
  is_monoid_hom.mk (is_add_monoid_hom.map_zero f)

theorem additive.is_add_group_hom {α : Type u} {β : Type v} [group α] [group β] (f : α → β) [is_group_hom f] : is_add_group_hom f :=
  is_add_group_hom.mk

theorem multiplicative.is_group_hom {α : Type u} {β : Type v} [add_group α] [add_group β] (f : α → β) [is_add_group_hom f] : is_group_hom f :=
  is_group_hom.mk


/- *** assume and intro(s) *** -/

/-
Assume P, Q, and R are propositions in this
variables (P Q R : Prop). This means they will
be "introduced/assumed" implicity as needed in
all definitions that follow.
-/
variables (P Q R : Prop)

/-
The assume and intro(s) tactics work the same.
They implement ∀ and → introduction. That is,
if you need to prove ∀ (p : P), Q or P → Q, you
need to assume you're given a proof/value of P
and show that in that context you can derive a
proof/value of Q. Consider this example then
read the discussion that follows.
-/

example : P → Q :=
begin
/-
Note: P, Q are already introduced as props.
What remains to be proved is P → Q. We can
prove it using arrow introduction: assume P,
show Q (in the context of that assumption),
and finally conclude P → Q.
-/
assume p,
show Q,
_
/-
The show tactic does nothing here. It can
be used to select from among multiple goals,
or to change the form of the goal as long
as it means exactly the same thing as the
original goal. It's used to make our formal
proof scripts readable and self-documenting.

Of course we have no way to prove Q here.
What the example shows is how to start to
prove any implication: assume P, show Q!
-/
end

example : ∀ (p : P), Q :=
begin
  /-
  Note: What remains to be proved is P → Q
  What? Yeah! ∀ (p : P), Q means the same thing
  as P → Q, and that's how Lean prefers to print
  it! The intro keyword implements ∀ introduction.
  For stylistic purposes, specifiers might prefer
  to use intro(s) instead of assume. Your choice.
  -/
  intro p,
  show Q,
  _
end

/-
You can make multiple assumptions in one line
of proof script, using either assume or intros
(plural).
-/

-- using intros
example : ∀ (n m : ℕ), n + m = 0 :=
begin
  intros n m,
  _
end

-- using assume
example : ∀ (n m : ℕ), n + m = 0 :=
begin
  assume n m,
  _
end