/-
The functor typeclass enables us to change the behavior
of (what amounts to) function *application* In particular,
the functor.map operation (<$>) lifts any pure function,
h : α → β, to a "structure-preserving" function on data
values containing α and β values: e.g., mapping options,
lists, or trees of α values into structurally identical
trees of β values. Preservation of structure is assured
by the functor laws.
-/

/-
The applicative functor typeclass enables us to change
the behavior of *multi-argument* function application.
The pure function takes a function and lifts it into
one that can then serve as a first argument to the seq
function, which then "applies" that function to a data
structure containing first arguments to that function.
The result is then a data structure holding partially
evaluated functions that is then "applied" to the next
data structure containing argument values. Overriding
the definitions of pure and seq in particular ways for
different data structures, such as option and list,
has given us nice ways to implement "non-deterministic"
function application as well as "exceptions" over
applications of functions to multiple arguments. Note:
an applicative functor *is a kind of functor,* so we
can assume that the map function is available when we
define pure and seq.
-/

/-
We can now state the purpose of the monad typeclass.
In short, it provides a way to override the behavior
of function *composition* so that additional data and
behavior can be overlaid on top of ordinary function
composition, just as the applicative functor let us
overlay extra data and behavior on ordinary function
*application*.

Composition is a super-power because because it lets
us decompose complex computations into compositions
of simple computations.

As an example, suppose we want to get a dog but not
one that will make our house all furry. So we go to
the animal shelter. There are two dogs there, polly
and fido. Polly is a poodle and fido is a husky.

We don't want a dog that will mess up our house by
leaving lots of fur around. What we need then is a
function that given a particular dog as input tells
us whether that dog is messy. For each dog we'll want
a yes/no answer: is is this dog *messy* or not?

messy : dogs → yesno

How should we implement messy? The trick is to see
that we can break it into a composition of simpler
functions. (1) We note that whether a dog is messy
if and only if it sheds. Whether it sheds depends
on its coat: if it has hair it doesn't shed, but if
it has fur, it does shed.  Whether a dog has fur or
hair depends, in turn, on its breed. Poodles have
hair. Husky's have fur.

So we can now see how to solve the problem. Given
one of the dogs as input, compute its breed (husky
or poodle); then use that "output" as the input to
a second function that takes a breed as input and
outputs its coat type (fur or hair); next use that
output as the input to a function that indicates
whether that kind of coat sheds or not (yes/no).
We will take the answer to the last question as
the answer to the overall question of whether a
given dog is *messy*.

Suppose we have functions to solve each of these
smaller problems.

breed : dogs → breeds
coat : breeds → coats
sheds : coats → yesno

Having broken our problem up into these parts, we
now need a way to compose them into the function
we seek, messy : dogs → yesno.
-/

namespace hidden

-- Data types
inductive dogs | fido | polly
inductive breeds | poodle | husky
inductive coats | fur | hair
inductive yesno | yes | no

open dogs breeds coats yesno

-- Component functions
def breed : dogs → breeds
| polly := poodle
| fido := husky

def coat : breeds → coats
| poodle := hair
| husky := fur

def sheds : coats → yesno
| fur := yes
| hair := no

/-
Composition is the operation of "connecting"
the output of one function to the input of a
next one to produce a new function from initial
input to final output. We can thus chain together
our three functions to get our desired overall
solution.
-/

def messy := sheds ∘ coat ∘ breed

/-
We pronounce (sheds ∘ coat ∘ breed) as
"sheds after coat after breed." When applied
to a dog, d, this function first applies breed,
then feeds the result to coat, then feeds that
result to sheds and finally returns the desired
yes/no result. Note that the argument on the
right sort of flows right to left through this
function composition.
-/

#check messy  -- isMessy : dogs → messy
#reduce messy -- λ (x : dogs), sheds (breed x)

example : messy polly = no := rfl
example : messy fido = yes := rfl

/-
Function composition is associative.
-/

theorem comp_assoc :
  ∀ {α β γ δ : Type }
    (k : γ → δ)
    (g : β → γ)
    (f : α → β),
  (k ∘ g) ∘ f = k ∘ (g ∘ f) :=
sorry

-- hint
#check @funext

/-
Let's unpack one of these examples. We know now that
(messy polly) reduces to no. We also know that it
applies (λ d, (sheds (coat (breed d)))) to (polly).
It binds d to polly, then applies breed then coat
and then sheds.

What we see is that ordinary function composition
notation gives us a sort of "backwards" or inside out
sequential notation: the last operation to be applied
is the leftmost one in the expression. On the other
hand, we can think of this sequence in a more usual
(for English speakers) left to right or top to bottom
sequence.

With a simple notational change we can express the
same composition of functions in a more natural manner.
The secret is to use binding operations. First we bind
b to the result of applying breed to polly, then we
bind c to the result of applying coat to b then we
bind m to the result of apply sheds to c, and finally
we "return" (reduce to) m. What we end up with looks
a lot more like typical "sequential" code of the kind
we find in imperative languages.
-/

def isPollyMessy :=
  (let
    b := (breed polly) in let
    c := (coat b) in let
    m := (sheds c) in
    m
  )

/-
If we generalize the choice of polly as the dog in
this case (replacing it with a parameter) then we
get our messy function back.
-/
def messy' (d : dogs) :=
(let
  b := (breed d) in let   -- bind b, call rest
  c := (coat b)  in let   -- bind c, call rest
  m := (sheds c) in       -- bind m, call rest
        m                 -- "return" m
)

-- It's exactly the same as sheds ∘ coat ∘ breed
example : messy' = messy := rfl

/-
One of the things that a "monad" does is to allow
us to write compositions of a richer kind in this
sort of sequential style. But we don't need monad
to understand this idea. We can easily define a
new notation that allows us to write the program
we've written here in a left-to-right sequential
style.
-/

/-
The easy trick is to define a notation for function
application where the argument is on the left and
the function is on the right. We can then think of
"feeding" each argument into the function on the
right. Let's use >> as an infix notation of this
style of function application.
-/

local notation v ` >> ` f :120 := f v

#reduce
  polly >>  -- a pure argument bound as argument of rest
  breed >>  -- apply bread to incoing, pass result to rest
  coat >>   -- apply coat to incoming, pass result to rest
  sheds     -- apply sheds to incoming, return final result

/-
Function application is *left* associative, so what we
have here is polly being fed to breed reducing to some
breed, which is fed to coat, reducing to some coat, which
is fed to sheds, reducing to a yes/no value. It's still
just ordinary everyday function composition/application.
-/

#reduce (((polly >> breed) >> coat) >> sheds)

/-
So now we have an abstraction of a sequential pipeline
that works by taking an argument (in general the result
of a preceding computation), and passes that value as
the argument to "the rest of the pipeline."
-/

/-
Let's look at another way we can write this code,
starting with just (polly >> breed).
-/

#reduce
    (λ d, breed d)  -- bind d and compute (breed d)
    polly           -- argument bound to d

#reduce
  (λ b, coat b)     -- bind b to result of the rest then compute (coat b)
    ((λ d, breed d) -- argument ("the rest")
      polly
    )

#reduce polly >> breed >> coat >> sheds
#reduce
  (λ c, sheds c)  -- bind c to result of rest then compute (sheds c)
    ((λ b, coat b) -- argument (rest)
      ((λ d, breed d)
          polly
      )
  )

/-
Yet another way to write the same code, then, is as
a sequence of binding operation. Here we bind c to
the result of "running the rest of the computation"
then we process c. And the rest of the computation
is structured in the same way. We present this style
again to demystify some of the syntactic constructs
we'll see next, when we turn to monads, which simply
provide a way to compose functions, let's call them
"monadic functions" that return not pure results, of
some type β, but "enriched" results, of type (m β),
where m is a type constructor such as list, option,
either, pair, etc.
-/

/-
With this discussion of composition in mind, and now
understanding that a monad is a typeclass that enables
composition of monadic functions, please continue to
the monad.lean file.
-/

end hidden


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

! This file was ported from Lean 3 source module data.finset.mul_antidiagonal
! leanprover-community/mathlib commit 0a0ec35061ed9960bf0e7ffb0335f44447b58977
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Pointwise.Basic
import Mathlib.Data.Set.MulAntidiagonal

/-! # Multiplication antidiagonal as a `Finset`.

We construct the `Finset` of all pairs
of an element in `s` and an element in `t` that multiply to `a`,
given that `s` and `t` are well-ordered.-/

namespace Set

open Pointwise

variable {α : Type _} {s t : Set α}

@[to_additive]
theorem IsPwo.mul [OrderedCancelCommMonoid α] (hs : s.IsPwo) (ht : t.IsPwo) : IsPwo (s * t) := by
  rw [← image_mul_prod]
  exact (hs.prod ht).image_of_monotone (monotone_fst.mul' monotone_snd)
#align set.is_pwo.mul Set.IsPwo.mul
#align set.is_pwo.add Set.IsPwo.add

variable [LinearOrderedCancelCommMonoid α]

@[to_additive]
theorem IsWf.mul (hs : s.IsWf) (ht : t.IsWf) : IsWf (s * t) :=
  (hs.isPwo.mul ht.isPwo).isWf
#align set.is_wf.mul Set.IsWf.mul
#align set.is_wf.add Set.IsWf.add

@[to_additive]
theorem IsWf.min_mul (hs : s.IsWf) (ht : t.IsWf) (hsn : s.Nonempty) (htn : t.Nonempty) :
    (hs.mul ht).min (hsn.mul htn) = hs.min hsn * ht.min htn := by
  refine' le_antisymm (IsWf.min_le _ _ (mem_mul.2 ⟨_, _, hs.min_mem _, ht.min_mem _, rfl⟩)) _
  rw [IsWf.le_min_iff]
  rintro _ ⟨x, y, hx, hy, rfl⟩
  exact mul_le_mul' (hs.min_le _ hx) (ht.min_le _ hy)
#align set.is_wf.min_mul Set.IsWf.min_mul
#align set.is_wf.min_add Set.IsWf.min_add

end Set

namespace Finset

open Pointwise

variable {α : Type _}

variable [OrderedCancelCommMonoid α] {s t : Set α} (hs : s.IsPwo) (ht : t.IsPwo) (a : α)

/-- `Finset.mulAntidiagonal hs ht a` is the set of all pairs of an element in `s` and an
element in `t` that multiply to `a`, but its construction requires proofs that `s` and `t` are
well-ordered. -/
@[to_additive "`Finset.addAntidiagonal hs ht a` is the set of all pairs of an element in
`s` and an element in `t` that add to `a`, but its construction requires proofs that `s` and `t` are
well-ordered."]
noncomputable def mulAntidiagonal : Finset (α × α) :=
  (Set.MulAntidiagonal.finite_of_isPwo hs ht a).toFinset
#align finset.mul_antidiagonal Finset.mulAntidiagonal
#align finset.add_antidiagonal Finset.addAntidiagonal

variable {hs ht a} {u : Set α} {hu : u.IsPwo} {x : α × α}

@[to_additive (attr := simp)]
theorem mem_mulAntidiagonal : x ∈ mulAntidiagonal hs ht a ↔ x.1 ∈ s ∧ x.2 ∈ t ∧ x.1 * x.2 = a := by
  simp only [mulAntidiagonal, Set.Finite.mem_toFinset, Set.mem_mulAntidiagonal]
#align finset.mem_mul_antidiagonal Finset.mem_mulAntidiagonal
#align finset.mem_add_antidiagonal Finset.mem_addAntidiagonal

@[to_additive]
theorem mulAntidiagonal_mono_left (h : u ⊆ s) : mulAntidiagonal hu ht a ⊆ mulAntidiagonal hs ht a :=
  Set.Finite.toFinset_mono <| Set.mulAntidiagonal_mono_left h
#align finset.mul_antidiagonal_mono_left Finset.mulAntidiagonal_mono_left
#align finset.add_antidiagonal_mono_left Finset.addAntidiagonal_mono_left

@[to_additive]
theorem mulAntidiagonal_mono_right (h : u ⊆ t) :
    mulAntidiagonal hs hu a ⊆ mulAntidiagonal hs ht a :=
  Set.Finite.toFinset_mono <| Set.mulAntidiagonal_mono_right h
#align finset.mul_antidiagonal_mono_right Finset.mulAntidiagonal_mono_right
#align finset.add_antidiagonal_mono_right Finset.addAntidiagonal_mono_right

-- Porting note: removed `(attr := simp)`. simp can prove this.
@[to_additive]
theorem swap_mem_mulAntidiagonal :
    x.swap ∈ Finset.mulAntidiagonal hs ht a ↔ x ∈ Finset.mulAntidiagonal ht hs a := by
  simp only [mem_mulAntidiagonal, Prod.fst_swap, Prod.snd_swap, Set.swap_mem_mulAntidiagonal_aux,
             Set.mem_mulAntidiagonal]
#align finset.swap_mem_mul_antidiagonal Finset.swap_mem_mulAntidiagonal
#align finset.swap_mem_add_antidiagonal Finset.swap_mem_addAntidiagonal

@[to_additive]
theorem support_mulAntidiagonal_subset_mul : { a | (mulAntidiagonal hs ht a).Nonempty } ⊆ s * t :=
  fun a ⟨b, hb⟩ => by
  rw [mem_mulAntidiagonal] at hb
  exact ⟨b.1, b.2, hb⟩
#align finset.support_mul_antidiagonal_subset_mul Finset.support_mulAntidiagonal_subset_mul
#align finset.support_add_antidiagonal_subset_add Finset.support_addAntidiagonal_subset_add

@[to_additive]
theorem isPwo_support_mulAntidiagonal : { a | (mulAntidiagonal hs ht a).Nonempty }.IsPwo :=
  (hs.mul ht).mono support_mulAntidiagonal_subset_mul
#align finset.is_pwo_support_mul_antidiagonal Finset.isPwo_support_mulAntidiagonal
#align finset.is_pwo_support_add_antidiagonal Finset.isPwo_support_addAntidiagonal

@[to_additive]
theorem mulAntidiagonal_min_mul_min {α} [LinearOrderedCancelCommMonoid α] {s t : Set α}
    (hs : s.IsWf) (ht : t.IsWf) (hns : s.Nonempty) (hnt : t.Nonempty) :
    mulAntidiagonal hs.isPwo ht.isPwo (hs.min hns * ht.min hnt) = {(hs.min hns, ht.min hnt)} := by
  ext ⟨a, b⟩
  simp only [mem_mulAntidiagonal, mem_singleton, Prod.ext_iff]
  constructor
  · rintro ⟨has, hat, hst⟩
    obtain rfl :=
      (hs.min_le hns has).eq_of_not_lt fun hlt =>
        (mul_lt_mul_of_lt_of_le hlt <| ht.min_le hnt hat).ne' hst
    exact ⟨rfl, mul_left_cancel hst⟩
  · rintro ⟨rfl, rfl⟩
    exact ⟨hs.min_mem _, ht.min_mem _, rfl⟩
#align finset.mul_antidiagonal_min_mul_min Finset.mulAntidiagonal_min_mul_min
#align finset.add_antidiagonal_min_add_min Finset.addAntidiagonal_min_add_min

end Finset


/-
Eq
-/

#check @eq  -- binary relation : α → α → α

#print eq
/-
inductive eq : Π {α : Sort u}, α → α → Prop
constructors:
eq.refl : ∀ {α : Sort u} (a : α), a = a
-/

/-
Properties
-/
#print eq

/-
-- reflexive    -- constructor
-- symmetric    <- reflexive
-- transitive   <- reflexive
-- equivalence  <- resymtr
-/

/-
AXIOMS
-/

/-
refl: Every thing equals itself
-/
#check @eq.refl
/-
eq.refl: from any a, proof of a = a
-/
-- the only eq constructor
-- the one introduction rule

-- the one elimination rule
-- substitution of equals
/-
      subst

        C : α → Prop
      /   \
    /       \
C a   >a=b>   C b

-/

#check @eq.rec

-- What does this type say?

/-
eq.rec :
  Π {α : Sort u_2}
    {a : α}
    {C : α → Sort u_1},
    C a →
    Π {ᾰ : α},
    a = ᾰ →
    C ᾰ
-/

/-
For any type of object, α,
for any a of this type,
and for any property, C α, of objects of type α,
If you know or assume that a has property C
then for any other object, ᾰ, of type α
if you know or assume that a and ᾰ are equal
then you may conclude that ᾰ also has that proeprty, C.
So, if you need to prove C b it suffices to show C a and a = b.
Subst uses an equality a = b in order to rewrite a term C a to C b.
-/

/-
Prove that symmetry and transitivty are now theorems
-/

#check @eq.symm

example : ∀ {α : Type } {a b : α}, a = b ↔ b = a :=
begin
  assume α a b,
  split,
  assume h,
  rw h,
  assume h,
  rw h,
end

example : ∀ {α : Type } {a b : α}, a = b ↔ b = a :=
λ α a b,
  (iff.intro
    (λ aeqb,
      (
        let s := eq.symm aeqb
        in eq.subst aeqb (eq.refl a)
      )
    )
    (_)                 -- exercise!
  )

#check @eq.trans        -- exercise

-- tactic script
example : ∀ {α : Type } {a b c : α}, a = b → b = c → a = c :=
_

-- Lean term
example : ∀ {α : Type } {a b c : α}, a = b → b = c → a = c :=
_


import group_theory.group_action.basic
import tactic
import data.setoid.partition

variables {G : Type*} [group G] {S : Type} {s t u : S} [mul_action G S]

open mul_action

theorem mem_orbit_refl (s : S) : s ∈ orbit G s :=
begin
  -- we could use `1 : G` but this is already in the library under another name
  exact mem_orbit_self s,
end

theorem mem_orbit_symm (h : s ∈ orbit G t) : t ∈ orbit G s :=
begin
  rw mem_orbit_iff at *,
  -- h says ∃ x, x • t = s so let's let `a` be that `x` and
  -- then replace `s` by `a • t` everywhere (that's the `rfl`)
  rcases h with ⟨a, rfl⟩,
  -- By the maths proof, we use a⁻¹
  use a⁻¹,
  -- now the simplifier can solve this equality
  simp,
end

theorem mem_orbit_trans (hst : s ∈ orbit G t) (htu : t ∈ orbit G u) :
  s ∈ orbit G u :=
begin
  rw mem_orbit_iff at *,
  -- we know a • t = s and b • u = t
  rcases hst with ⟨a, rfl⟩,
  rcases htu with ⟨b, rfl⟩,
  -- so we have to solve `∃ x, x • u = a • b • u`
  use a * b,
  exact mul_smul a b u, -- I know the axiom name
end

open set

variable (G)

theorem orbit_nonempty (s : S) : set.nonempty (orbit G s) :=
begin
  rw nonempty_def,
  -- the orbit is nonempty because it contains s
  use s,
  -- and here's the proof that s is in its own orbit
  exact mem_orbit_refl s,
end

variable {G}
theorem mem_orbit (s : S) : ∃ (t : S), s ∈ orbit G t :=
begin
  -- we can use t = s
  use s,
  -- and here's the proof that s is in its own orbit
  exact mem_orbit_refl s,
end

variable {a : S}

theorem boring_lemma (has : a ∈ orbit G s) (hat : a ∈ orbit G t) : s ∈ orbit G t :=
begin
  -- this is a little logic puzzle. Note that my proof is backwards
  refine mem_orbit_trans _ hat,
  exact mem_orbit_symm has,
end

theorem orbit_subset_of_mem_orbit (hst : s ∈ orbit G t) : orbit G s ⊆ orbit G t :=
begin
  rintros u hu,
  exact mem_orbit_trans hu hst,
end

theorem orbit_eq_orbit_of_mem_inter (has : a ∈ orbit G s) (hat : a ∈ orbit G t) :
  orbit G s = orbit G t :=
begin
  -- ⊆ is antisymmetric
  apply subset.antisymm,
  { -- both cases follow from the boring lemma and `orbit_subset_of_mem_orbit`
    apply orbit_subset_of_mem_orbit,
    exact boring_lemma has hat, },
  { apply orbit_subset_of_mem_orbit,
    exact boring_lemma hat has, }
end

variable {g : G}

open setoid

-- this is harder and can probably be golfed.
example : is_partition {𝒪 : set S | ∃ s, orbit G s = 𝒪} :=
begin
  refine ⟨_, _⟩,
  { rintro ⟨s, hs⟩,
    exact not_nonempty_iff_eq_empty.mpr hs (orbit_nonempty G s), },
  intro s,
  refine exists_unique_of_exists_of_unique _ _,
  { use orbit G s,
    simp },
  { rintro A B ⟨⟨t, rfl⟩, hst, -⟩ ⟨⟨u, rfl⟩, hsu, -⟩,
    exact orbit_eq_orbit_of_mem_inter hst hsu, },
end


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

! This file was ported from Lean 3 source module category_theory.skeletal
! leanprover-community/mathlib commit 28aa996fc6fb4317f0083c4e6daf79878d81be33
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Adjunction.Basic
import Mathlib.CategoryTheory.Category.Preorder
import Mathlib.CategoryTheory.IsomorphismClasses
import Mathlib.CategoryTheory.Thin

/-!
# Skeleton of a category

Define skeletal categories as categories in which any two isomorphic objects are equal.

Construct the skeleton of an arbitrary category by taking isomorphism classes, and show it is a
skeleton of the original category.

In addition, construct the skeleton of a thin category as a partial ordering, and (noncomputably)
show it is a skeleton of the original category. The advantage of this special case being handled
separately is that lemmas and definitions about orderings can be used directly, for example for the
subobject lattice. In addition, some of the commutative diagrams about the functors commute
definitionally on the nose which is convenient in practice.
-/

universe v₁ v₂ v₃ u₁ u₂ u₃

namespace CategoryTheory

open Category

variable (C : Type u₁) [Category.{v₁} C]

variable (D : Type u₂) [Category.{v₂} D]

variable {E : Type u₃} [Category.{v₃} E]

/-- A category is skeletal if isomorphic objects are equal. -/
def Skeletal : Prop :=
  ∀ ⦃X Y : C⦄, IsIsomorphic X Y → X = Y
#align category_theory.skeletal CategoryTheory.Skeletal

/-- `IsSkeletonOf C D F` says that `F : D ⥤ C` exhibits `D` as a skeletal full subcategory of `C`,
in particular `F` is a (strong) equivalence and `D` is skeletal.
-/
structure IsSkeletonOf (F : D ⥤ C) where
  /-- The category `D` has isomorphic objects equal -/
  skel : Skeletal D
  /-- The functor `F` is an equivalence -/
  eqv : IsEquivalence F
#align category_theory.is_skeleton_of CategoryTheory.IsSkeletonOf

attribute [local instance] isIsomorphicSetoid

variable {C D}

/-- If `C` is thin and skeletal, then any naturally isomorphic functors to `C` are equal. -/
theorem Functor.eq_of_iso {F₁ F₂ : D ⥤ C} [Quiver.IsThin C] (hC : Skeletal C) (hF : F₁ ≅ F₂) :
    F₁ = F₂ :=
  Functor.ext (fun X => hC ⟨hF.app X⟩) fun _ _ _ => Subsingleton.elim _ _
#align category_theory.functor.eq_of_iso CategoryTheory.Functor.eq_of_iso

/-- If `C` is thin and skeletal, `D ⥤ C` is skeletal.
`CategoryTheory.functor_thin` shows it is thin also.
-/
theorem functor_skeletal [Quiver.IsThin C] (hC : Skeletal C) : Skeletal (D ⥤ C) := fun _ _ h =>
  h.elim (Functor.eq_of_iso hC)
#align category_theory.functor_skeletal CategoryTheory.functor_skeletal

variable (C D)

/-- Construct the skeleton category as the induced category on the isomorphism classes, and derive
its category structure.
-/
def Skeleton : Type u₁ := InducedCategory C Quotient.out
#align category_theory.skeleton CategoryTheory.Skeleton

instance [Inhabited C] : Inhabited (Skeleton C) :=
  ⟨⟦default⟧⟩

-- Porting note: previously `Skeleton` used `deriving Category`
noncomputable instance : Category (Skeleton C) := by
  apply InducedCategory.category

/-- The functor from the skeleton of `C` to `C`. -/
@[simps!]
noncomputable def fromSkeleton : Skeleton C ⥤ C :=
  inducedFunctor _
#align category_theory.from_skeleton CategoryTheory.fromSkeleton

-- Porting note: previously `fromSkeleton` used `deriving Faithful, Full`
noncomputable instance : Full <| fromSkeleton C := by
  apply InducedCategory.full
noncomputable instance : Faithful <| fromSkeleton C := by
  apply InducedCategory.faithful

instance : EssSurj (fromSkeleton C) where mem_essImage X := ⟨Quotient.mk' X, Quotient.mk_out X⟩

-- Porting note: named this instance
noncomputable instance fromSkeleton.isEquivalence : IsEquivalence (fromSkeleton C) :=
  Equivalence.ofFullyFaithfullyEssSurj (fromSkeleton C)

/-- The equivalence between the skeleton and the category itself. -/
noncomputable def skeletonEquivalence : Skeleton C ≌ C :=
  (fromSkeleton C).asEquivalence
#align category_theory.skeleton_equivalence CategoryTheory.skeletonEquivalence

theorem skeleton_skeletal : Skeletal (Skeleton C) := by
  rintro X Y ⟨h⟩
  have : X.out ≈ Y.out := ⟨(fromSkeleton C).mapIso h⟩
  simpa using Quotient.sound this
#align category_theory.skeleton_skeletal CategoryTheory.skeleton_skeletal

/-- The `skeleton` of `C` given by choice is a skeleton of `C`. -/
noncomputable def skeletonIsSkeleton : IsSkeletonOf C (Skeleton C) (fromSkeleton C) where
  skel := skeleton_skeletal C
  eqv := fromSkeleton.isEquivalence C
#align category_theory.skeleton_is_skeleton CategoryTheory.skeletonIsSkeleton

section

variable {C D}

/-- Two categories which are categorically equivalent have skeletons with equivalent objects.
-/
noncomputable def Equivalence.skeletonEquiv (e : C ≌ D) : Skeleton C ≃ Skeleton D :=
  let f := ((skeletonEquivalence C).trans e).trans (skeletonEquivalence D).symm
  { toFun := f.functor.obj
    invFun := f.inverse.obj
    left_inv := fun X => skeleton_skeletal C ⟨(f.unitIso.app X).symm⟩
    right_inv := fun Y => skeleton_skeletal D ⟨f.counitIso.app Y⟩ }
#align category_theory.equivalence.skeleton_equiv CategoryTheory.Equivalence.skeletonEquiv

end

/-- Construct the skeleton category by taking the quotient of objects. This construction gives a
preorder with nice definitional properties, but is only really appropriate for thin categories.
If your original category is not thin, you probably want to be using `skeleton` instead of this.
-/
def ThinSkeleton : Type u₁ :=
  Quotient (isIsomorphicSetoid C)
#align category_theory.thin_skeleton CategoryTheory.ThinSkeleton

instance inhabitedThinSkeleton [Inhabited C] : Inhabited (ThinSkeleton C) :=
  ⟨@Quotient.mk' C (isIsomorphicSetoid C) default⟩
#align category_theory.inhabited_thin_skeleton CategoryTheory.inhabitedThinSkeleton

instance ThinSkeleton.preorder : Preorder (ThinSkeleton C)
    where
  le :=
    @Quotient.lift₂ C C _ (isIsomorphicSetoid C) (isIsomorphicSetoid C)
      (fun X Y => Nonempty (X ⟶ Y))
        (by
          rintro _ _ _ _ ⟨i₁⟩ ⟨i₂⟩
          exact
            propext
              ⟨Nonempty.map fun f => i₁.inv ≫ f ≫ i₂.hom,
                Nonempty.map fun f => i₁.hom ≫ f ≫ i₂.inv⟩)
  le_refl := by
    refine' Quotient.ind fun a => _
    exact ⟨𝟙 _⟩
  le_trans a b c := Quotient.inductionOn₃ a b c fun A B C => Nonempty.map2 (· ≫ ·)
#align category_theory.thin_skeleton.preorder CategoryTheory.ThinSkeleton.preorder

/-- The functor from a category to its thin skeleton. -/
@[simps]
def toThinSkeleton : C ⥤ ThinSkeleton C where
  obj := @Quotient.mk' C _
  map f := homOfLE (Nonempty.intro f)
#align category_theory.to_thin_skeleton CategoryTheory.toThinSkeleton

/-!
The constructions here are intended to be used when the category `C` is thin, even though
some of the statements can be shown without this assumption.
-/

namespace ThinSkeleton

/-- The thin skeleton is thin. -/
instance thin : Quiver.IsThin (ThinSkeleton C) := fun _ _ =>
  ⟨by
    rintro ⟨⟨f₁⟩⟩ ⟨⟨_⟩⟩
    rfl⟩
#align category_theory.thin_skeleton.thin CategoryTheory.ThinSkeleton.thin

variable {C} {D}

/-- A functor `C ⥤ D` computably lowers to a functor `ThinSkeleton C ⥤ ThinSkeleton D`. -/
@[simps]
def map (F : C ⥤ D) : ThinSkeleton C ⥤ ThinSkeleton D where
  obj := Quotient.map F.obj fun X₁ X₂ ⟨hX⟩ => ⟨F.mapIso hX⟩
  map {X} {Y} := Quotient.recOnSubsingleton₂ X Y fun x y k => homOfLE (k.le.elim fun t => ⟨F.map t⟩)
#align category_theory.thin_skeleton.map CategoryTheory.ThinSkeleton.map

theorem comp_toThinSkeleton (F : C ⥤ D) : F ⋙ toThinSkeleton D = toThinSkeleton C ⋙ map F :=
  rfl
#align category_theory.thin_skeleton.comp_to_thin_skeleton CategoryTheory.ThinSkeleton.comp_toThinSkeleton

/-- Given a natural transformation `F₁ ⟶ F₂`, induce a natural transformation `map F₁ ⟶ map F₂`.-/
def mapNatTrans {F₁ F₂ : C ⥤ D} (k : F₁ ⟶ F₂) : map F₁ ⟶ map F₂
    where app X := Quotient.recOnSubsingleton X fun x => ⟨⟨⟨k.app x⟩⟩⟩
#align category_theory.thin_skeleton.map_nat_trans CategoryTheory.ThinSkeleton.mapNatTrans

/- Porting note: `map₂ObjMap`, `map₂Functor`, and `map₂NatTrans` were all extracted
from the original `map₂` proof. Lean needed an extensive amount explicit type
annotations to figure things out. This also translated into repeated deterministic
timeouts. The extracted defs allow for explicit motives for the multiple
descents to the quotients.

It would be better to prove that
`ThinSkeleton (C × D) ≌ ThinSkeleton C × ThinSkeleton D`
which is more immediate from comparing the preorders. Then one could get
`map₂` by currying.
-/
/-- Given a bifunctor, we descend to a function on objects of `ThinSkeleton` -/
def map₂ObjMap (F : C ⥤ D ⥤ E) : ThinSkeleton C → ThinSkeleton D → ThinSkeleton E :=
  fun x y =>
    @Quotient.map₂ C D (isIsomorphicSetoid C) (isIsomorphicSetoid D) E (isIsomorphicSetoid E)
      (fun X Y => (F.obj X).obj Y)
          (fun X₁ _ ⟨hX⟩ _ Y₂ ⟨hY⟩ => ⟨(F.obj X₁).mapIso hY ≪≫ (F.mapIso hX).app Y₂⟩) x y

/-- For each `x : ThinSkeleton C`, we promote `map₂ObjMap F x` to a functor -/
def map₂Functor (F : C ⥤ D ⥤ E) : ThinSkeleton C → ThinSkeleton D ⥤ ThinSkeleton E :=
  fun x =>
    { obj := fun y => map₂ObjMap F x y
      map := fun {y₁} {y₂} => @Quotient.recOnSubsingleton C (isIsomorphicSetoid C)
        (fun x => (y₁ ⟶  y₂) → (map₂ObjMap F x y₁ ⟶  map₂ObjMap F x y₂)) _ x fun X
          => Quotient.recOnSubsingleton₂ y₁ y₂ fun Y₁ Y₂ hY =>
            homOfLE (hY.le.elim fun g => ⟨(F.obj X).map g⟩) }

/-- This provides natural transformations `map₂Functor F x₁ ⟶  map₂Functor F x₂` given
`x₁ ⟶  x₂` -/
def map₂NatTrans (F : C ⥤ D ⥤ E) : {x₁ x₂ : ThinSkeleton C} → (x₁ ⟶  x₂) →
    (map₂Functor F x₁ ⟶  map₂Functor F x₂) := fun {x₁} {x₂} =>
  @Quotient.recOnSubsingleton₂ C C (isIsomorphicSetoid C) (isIsomorphicSetoid C)
    (fun x x' : ThinSkeleton C => (x ⟶  x') → (map₂Functor F x ⟶  map₂Functor F x')) _ x₁ x₂
    (fun X₁ X₂ f => { app := fun y =>
      Quotient.recOnSubsingleton y fun Y => homOfLE (f.le.elim fun f' => ⟨(F.map f').app Y⟩) })

-- TODO: state the lemmas about what happens when you compose with `toThinSkeleton`
/-- A functor `C ⥤ D ⥤ E` computably lowers to a functor
`ThinSkeleton C ⥤ ThinSkeleton D ⥤ ThinSkeleton E` -/
@[simps]
def map₂ (F : C ⥤ D ⥤ E) : ThinSkeleton C ⥤ ThinSkeleton D ⥤ ThinSkeleton E where
  obj := map₂Functor F
  map := map₂NatTrans F
#align category_theory.thin_skeleton.map₂ CategoryTheory.ThinSkeleton.map₂

variable (C)

section

variable [Quiver.IsThin C]

instance toThinSkeleton_faithful : Faithful (toThinSkeleton C) where
#align category_theory.thin_skeleton.to_thin_skeleton_faithful CategoryTheory.ThinSkeleton.toThinSkeleton_faithful

/-- Use `Quotient.out` to create a functor out of the thin skeleton. -/
@[simps]
noncomputable def fromThinSkeleton : ThinSkeleton C ⥤ C where
  obj := Quotient.out
  map {x} {y} :=
    Quotient.recOnSubsingleton₂ x y fun X Y f =>
      (Nonempty.some (Quotient.mk_out X)).hom ≫ f.le.some ≫ (Nonempty.some (Quotient.mk_out Y)).inv
#align category_theory.thin_skeleton.from_thin_skeleton CategoryTheory.ThinSkeleton.fromThinSkeleton

noncomputable instance fromThinSkeletonEquivalence : IsEquivalence (fromThinSkeleton C) where
  inverse := toThinSkeleton C
  counitIso := NatIso.ofComponents (fun X => Nonempty.some (Quotient.mk_out X)) (by aesop_cat)
  unitIso := NatIso.ofComponents (fun x => Quotient.recOnSubsingleton x fun X =>
          eqToIso (Quotient.sound ⟨(Nonempty.some (Quotient.mk_out X)).symm⟩)) (fun _ => rfl)
#align category_theory.thin_skeleton.from_thin_skeleton_equivalence CategoryTheory.ThinSkeleton.fromThinSkeletonEquivalence

/-- The equivalence between the thin skeleton and the category itself. -/
noncomputable def equivalence : ThinSkeleton C ≌ C :=
  (fromThinSkeleton C).asEquivalence
#align category_theory.thin_skeleton.equivalence CategoryTheory.ThinSkeleton.equivalence

variable {C}

theorem equiv_of_both_ways {X Y : C} (f : X ⟶ Y) (g : Y ⟶ X) : X ≈ Y :=
  ⟨iso_of_both_ways f g⟩
#align category_theory.thin_skeleton.equiv_of_both_ways CategoryTheory.ThinSkeleton.equiv_of_both_ways

instance thinSkeletonPartialOrder : PartialOrder (ThinSkeleton C) :=
  { CategoryTheory.ThinSkeleton.preorder C with
    le_antisymm :=
      Quotient.ind₂
        (by
          rintro _ _ ⟨f⟩ ⟨g⟩
          apply Quotient.sound (equiv_of_both_ways f g)) }
#align category_theory.thin_skeleton.thin_skeleton_partial_order CategoryTheory.ThinSkeleton.thinSkeletonPartialOrder

theorem skeletal : Skeletal (ThinSkeleton C) := fun X Y =>
  Quotient.inductionOn₂ X Y fun _ _ h => h.elim fun i => i.1.le.antisymm i.2.le
#align category_theory.thin_skeleton.skeletal CategoryTheory.ThinSkeleton.skeletal

theorem map_id_eq : map (𝟭 C) = 𝟭 (ThinSkeleton C) :=
  Functor.eq_of_iso skeletal <|
    NatIso.ofComponents (fun X => Quotient.recOnSubsingleton X fun x => Iso.refl _) (by aesop_cat)
#align category_theory.thin_skeleton.map_id_eq CategoryTheory.ThinSkeleton.map_id_eq

theorem map_iso_eq {F₁ F₂ : D ⥤ C} (h : F₁ ≅ F₂) : map F₁ = map F₂ :=
  Functor.eq_of_iso skeletal
    { hom := mapNatTrans h.hom
      inv := mapNatTrans h.inv }
#align category_theory.thin_skeleton.map_iso_eq CategoryTheory.ThinSkeleton.map_iso_eq

/-- `fromThinSkeleton C` exhibits the thin skeleton as a skeleton. -/
noncomputable def thinSkeletonIsSkeleton : IsSkeletonOf C (ThinSkeleton C) (fromThinSkeleton C)
    where
  skel := skeletal
  eqv := ThinSkeleton.fromThinSkeletonEquivalence C
#align category_theory.thin_skeleton.thin_skeleton_is_skeleton CategoryTheory.ThinSkeleton.thinSkeletonIsSkeleton

noncomputable instance isSkeletonOfInhabited :
    Inhabited (IsSkeletonOf C (ThinSkeleton C) (fromThinSkeleton C)) :=
  ⟨thinSkeletonIsSkeleton⟩
#align category_theory.thin_skeleton.is_skeleton_of_inhabited CategoryTheory.ThinSkeleton.isSkeletonOfInhabited

end

variable {C}

/-- An adjunction between thin categories gives an adjunction between their thin skeletons. -/
def lowerAdjunction (R : D ⥤ C) (L : C ⥤ D) (h : L ⊣ R) : ThinSkeleton.map L ⊣ ThinSkeleton.map R :=
  Adjunction.mkOfUnitCounit
    { unit :=
        {
          app := fun X => by
            letI := isIsomorphicSetoid C
            refine' Quotient.recOnSubsingleton X fun x => homOfLE ⟨h.unit.app x⟩ }
      -- TODO: make quotient.rec_on_subsingleton' so the letI isn't needed
      counit :=
        {
          app := fun X => by
            letI := isIsomorphicSetoid D
            refine' Quotient.recOnSubsingleton X fun x => homOfLE ⟨h.counit.app x⟩ } }
#align category_theory.thin_skeleton.lower_adjunction CategoryTheory.ThinSkeleton.lowerAdjunction

end ThinSkeleton

open ThinSkeleton

section

variable {C} {α : Type _} [PartialOrder α]

/--
When `e : C ≌ α` is a categorical equivalence from a thin category `C` to some partial order `α`,
the `ThinSkeleton C` is order isomorphic to `α`.
-/
noncomputable def Equivalence.thinSkeletonOrderIso [Quiver.IsThin C] (e : C ≌ α) :
    ThinSkeleton C ≃o α :=
  ((ThinSkeleton.equivalence C).trans e).toOrderIso
#align category_theory.equivalence.thin_skeleton_order_iso CategoryTheory.Equivalence.thinSkeletonOrderIso

end

end CategoryTheory


import .love10_denotational_semantics_demo

/-! # LoVe Homework 10: Denotational Semantics

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! The following command enables noncomputable decidability on every `Prop`.
The `priority 0` attribute ensures this is used only when necessary; otherwise,
it would make some computable definitions noncomputable for Lean. Depending on
how you solve question 2.2, this command might help you. -/

local attribute [instance, priority 0] classical.prop_decidable

/-! Denotational semantics are well suited to functional programming. In this
exercise, we will study some representations of functional programs in Lean and
their denotational semantics.

The `nondet` type represents functional programs that can perform
nondeterministic computations: A program can choose between many different
computation paths / return values. Returning no results at all is represented
by `fail`, and nondeterministic choice between two options (identified by the
`bool` values `tt` and `ff`) is represented by `choice`. -/

inductive nondet (α : Type) : Type
| pure    : α → nondet
| fail {} : nondet
| choice  : (bool → nondet) → nondet

namespace nondet

/-! ## Question 1 (4 points): The `nondet` Monad

The `nondet` inductive type forms a monad. The `pure` operator is `nondet.pure`.
`bind` is as follows: -/

def bind {α β : Type} : nondet α → (α → nondet β) → nondet β
| (pure x)   f := f x
| fail       f := fail
| (choice k) f := choice (λb, bind (k b) f)

instance : has_pure nondet :=
{ pure := @pure }

instance : has_bind nondet :=
{ bind := @bind }

/-! 1.1 (3 points). Prove the three monad laws for `nondet`.

Hints:

* To unfold the definition of `>>=`, invoke `simp [(>>=)]`.

* To prove `f = g` from `∀x, f x = g x`, use the theorem `funext`. -/

lemma pure_bind {α β : Type} (x : α) (f : α → nondet β) :
  pure x >>= f = f x :=
sorry

lemma bind_pure {α : Type} :
  ∀mx : nondet α, mx >>= pure = mx :=
sorry

lemma bind_assoc {α β γ : Type} :
  ∀(mx : nondet α) (f : α → nondet β) (g : β → nondet γ),
    ((mx >>= f) >>= g) = (mx >>= (λa, f a >>= g)) :=
sorry

/-! The function `portmanteau` computes a portmanteau of two lists: A
portmanteau of `xs` and `ys` has `xs` as a prefix and `ys` as a suffix, and they
overlap. We use `starts_with xs ys` to test that `ys` has `xs` as a prefix. -/

def starts_with : list ℕ → list ℕ → bool
| (x :: xs) []        := ff
| []        ys        := tt
| (x :: xs) (y :: ys) := (x = y) && starts_with xs ys

#eval starts_with [1, 2] [1, 2, 3]
#eval starts_with [1, 2, 3] [1, 2]

def portmanteau : list ℕ → list ℕ → list (list ℕ)
| []        ys := []
| (x :: xs) ys :=
  list.map (list.cons x) (portmanteau xs ys) ++
  (if starts_with (x :: xs) ys then [ys] else [])

/-! Here are some examples of portmanteaux: -/

#reduce portmanteau [0, 1, 2, 3] [2, 3, 4]
#reduce portmanteau [0, 1] [2, 3, 4]
#reduce portmanteau [0, 1, 2, 1, 2] [1, 2, 1, 2, 3, 4]

/-! 1.2 (1 point). Translate the `portmanteau` program from the `list` monad to
the `nondet` monad. -/

def nondet_portmanteau : list ℕ → list ℕ → nondet (list ℕ) :=
sorry

/-! ## Question 2 (5 points): Nondeterminism, Denotationally

2.1 (2 points). Give a denotational semantics for `nondet`, mapping it into a
`list` of all results. `pure` returns one result, `fail` returns zero, and
`choice` combines the results of either option. -/

def list_sem {α : Type} : nondet α → list α :=
sorry

/-! Check that the following lines give the same output as for `portmanteau` (if
you have answered question 1.2): -/

#reduce list_sem (nondet_portmanteau [0, 1, 2, 3] [2, 3, 4])
#reduce list_sem (nondet_portmanteau [0, 1] [2, 3, 4])
#reduce list_sem (nondet_portmanteau [0, 1, 2, 1, 2] [1, 2, 1, 2, 3, 4])

/-! 2.2 (2 points). Often, we are not interested in getting all outcomes, just
the first successful one. Give a semantics for `nondet` that produces the first
successful result, if any. Your solution should *not* use `list_sem`. -/

noncomputable def option_sem {α : Type} : nondet α → option α :=
sorry

/-! 2.3 (1 point). Prove the theorem `list_option_compat` below, showing that
the two semantics you defined are compatible. -/

lemma head'_orelse_eq_head'_append {α : Type} (xs ys : list α) :
  (list.head' xs <|> list.head' ys) = list.head' (xs ++ ys) :=
by induction' xs; simp

theorem list_option_compat {α : Type} :
  ∀mx : nondet α, option_sem mx = list.head' (list_sem mx) :=
sorry

end nondet

end LoVe


open classical

variables (α : Type) (p q : α → Prop)
variable a : α
variable r : Prop

--

-- using exists.elim
example : (∃ x : α, r) → r :=
assume h : ∃ x : α, r,
show r, from
exists.elim h
    (assume w,
    assume hw : r,
    hw)

-- using match
example : (∃ x : α, r) → r :=
assume h : ∃ x : α, r,
match h with ⟨w, (hw : r)⟩ :=
    hw
end

example : r → (∃ x : α, r) :=
assume hr : r,
⟨a, hr⟩

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
iff.intro
    (assume h : ∃ x, p x ∧ r,
        show (∃ x, p x) ∧ r, from
        match h with ⟨w, (hw : p w ∧ r)⟩ :=
            ⟨⟨w, hw.left⟩, hw.right⟩
        end)
    (assume h : (∃ x, p x) ∧ r,
        show ∃ x, p x ∧ r, from
        match h.left with ⟨w, (hw : p w)⟩ :=
            ⟨w, ⟨hw, h.right⟩⟩
        end)

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
iff.intro
    (assume h : (∃ x, p x ∨ q x),
        show (∃ x, p x) ∨ (∃ x, q x), from
        match h with ⟨w, (hw : p w ∨ q w)⟩ :=
            or.elim hw
                (assume hpw : p w,
                    or.inl ⟨w, hpw⟩)
                (assume hqw : q w,
                    or.inr ⟨w, hqw⟩)
        end)
    (assume h : (∃ x, p x) ∨ (∃ x, q x),
        show (∃ x, p x ∨ q x), from
        or.elim h
            (assume hleft : ∃ x, p x,
                match hleft with ⟨w, hw⟩ :=
                    ⟨w, or.inl hw⟩
                end)
            (assume hright : ∃ x, q x,
                match hright with ⟨w, hw⟩ :=
                    ⟨w, or.inr hw⟩
                end))

--

-- refactor some lemmas for reuse {

lemma not_exists_then_forall_not
    {α : Type} {p : α → Prop} : (¬ ∃ x, p x) → (∀ x, ¬ p x) :=
assume h : ¬ ∃ x, p x,
    show ∀ x, ¬ p x, from
    assume z : α,
    show ¬ p z, from
    (assume hpz : p z,
        show false, from
        h ⟨z, hpz⟩)

lemma not_not_exists_then_forall
    {α : Type} {p : α → Prop} : ¬ (∃ x, ¬ p x) → (∀ x, p x) :=
assume h : ¬ (∃ x, ¬ p x),
    show (∀ x, p x), from
    assume z : α,
    show p z, from
    by_contradiction
        (assume hnpz : ¬ p z,
            show false, from
            h ⟨z, hnpz⟩)

-- }

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
iff.intro
    (assume h : (∀ x, p x),
        show ¬ (∃ x, ¬ p x), from
        assume hneg : ∃ x, ¬ p x,
        show false, from
        match hneg with ⟨w, (hw : ¬ p w)⟩ :=
            absurd (h w) hw
        end)
    (assume h : ¬ (∃ x, ¬ p x),
        show (∀ x, p x), from
        not_not_exists_then_forall h)

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
iff.intro
    (assume h : ∃ x, p x,
        show ¬ (∀ x, ¬ p x), from
        match h with ⟨w, hw⟩ :=
            assume hneg : ∀ x, ¬ p x,
            show false, from
            absurd hw (hneg w)
        end)
    (assume h : ¬ (∀ x, ¬ p x), -- ∀ x, ¬ p x → false
        show ∃ x, p x, from
        by_contradiction
            (assume h_tofalsify : ¬ (∃ x, p x),
                have h2 : ∀ x, ¬ p x, from not_exists_then_forall_not h_tofalsify,
                absurd h2 h))

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
iff.intro
    (assume h : ¬ ∃ x, p x,
        show ∀ x, ¬ p x, from
        not_exists_then_forall_not h)
    (assume h : ∀ x, ¬ p x,
        show ¬ ∃ x, p x, from
        (assume h2 : ∃ x, p x,
            show false, from
            match h2 with ⟨w, hw⟩ :=
                absurd hw (h w)
            end))

theorem not_forall_iff_not_exists
    {α : Type} {p : α → Prop} : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
iff.intro
    (assume h : ¬ ∀ x, p x,
        show ∃ x, ¬ p x, from
        by_contradiction
            (assume h_tofalsify : ¬ (∃ x, ¬ p x),
                have h2 : ∀ x, p x, from not_not_exists_then_forall h_tofalsify,
                absurd h2 h))
    (assume h : ∃ x, ¬ p x,
        show ¬ ∀ x, p x, from
        match h with ⟨w, hw⟩ :=
            assume hallp : ∀ x, p x,
            show false, from
            absurd (hallp w) hw
        end)

--

example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
iff.intro
    (assume h : (∀ x, p x → r),
        show (∃ x, p x) → r, from
        (assume h2 : ∃ x, p x,
            show r, from
            match h2 with ⟨w, (hw : p w)⟩ :=
                (h w) hw
            end))
    (assume h : (∃ x, p x) → r,
        show ∀ x, p x → r, from
        assume z : α,
        show p z → r, from
            (assume hpz : p z,
                show r, from
                h ⟨z, hpz⟩))

example : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
iff.intro
    (assume h : ∃ x, p x → r,
        show (∀ x, p x) → r, from
        match h with ⟨w, (hw : p w → r)⟩ :=
            assume h2 : ∀ x, p x,
            show r, from
            hw (h2 w)
        end)
    (assume h : (∀ x, p x) → r,
        show ∃ x, p x → r, from
        by_cases
            (assume h_all : ∀ x, p x,
                ⟨a, (λ hpa, h h_all)⟩)
            (assume h_nall : ¬ ∀ x, p x,
                have h2 : ∃ x, ¬ p x, from not_forall_iff_not_exists.mp h_nall,
                match h2 with ⟨w, hw⟩ :=
                    ⟨w, (
                        show p w → r, from
                        (assume hpw : p w, absurd hpw hw)
                    )⟩
                end))

example : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
iff.intro
    (assume h : (∃ x, r → p x),
        show (r → ∃ x, p x), from
        match h with ⟨w, (hw : r → p w)⟩ :=
            assume hr : r,
            show ∃ x, p x, from
            ⟨w, hw hr⟩
        end)
    (assume h : (r → ∃ x, p x),
        show (∃ x, r → p x), from
        by_cases
            (assume hr : r,
                have h2 : ∃ x, p x, from h hr,
                match h2 with ⟨w, (hw : p w)⟩ :=
                    ⟨w, (λ _, hw)⟩
                end)
            (assume hnr : ¬r,
                ⟨a, (λ hr, absurd hr hnr)⟩))

--