Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- def ran (g h : Type → Type) (α : Type) := Π β, (α → g β) → h β
- def lan (g h : Type → Type) (α : Type) := Σ β, (g β → α) × h β
- def mapr {g h} {α β} (s : α → β) (x : ran g h α) : ran g h β :=
- λ b t, x b (t ∘ s)
- def mapl {g h} {α β} (s : α → β) (x : lan g h α) : lan g h β :=
- ⟨x.1, ⟨s ∘ x.2.1, x.2.2⟩⟩
- attribute [reducible] id
- attribute [simp] function.comp
- -- @[simp] lemma prod.mk.eta {α β} : Π {p : α × β}, (p.1, p.2) = p
- -- | (a, b) := rfl
- @[simp] lemma sigma.mk.eta {α} {β : α → Type} : Π {p : Σ α, β α}, sigma.mk p.1 p.2 = p
- | ⟨a, b⟩ := rfl
- instance {g h} : functor (ran g h) :=
- { map := @mapr g h }
- instance {g h} : is_lawful_functor (ran g h) :=
- { id_map := by intros; simp [functor.map, mapr],
- comp_map := by intros; simp [functor.map, mapr] }
- instance {g h} : functor (lan g h) :=
- { map := @mapl g h }
- instance {g h} : is_lawful_functor (lan g h) :=
- { id_map := by intros; simp [functor.map, mapl],
- comp_map := by intros; simp [functor.map, mapl] }
- def natural {f g} [functor f] [functor g] (t : Π {α}, f α → g α) :=
- Π {α β} {x : f α} (s : α → β), s <$> (t x) = t (s <$> x)
- axiom free_theorem {f g} [functor f] [functor g] (t : Π α, f α → g α) : natural t
- section yoneda
- variables {f : Type → Type} [functor f] [is_lawful_functor f] {α : Type}
- @[reducible] def yoneda := ran id
- def check (x : f α) : yoneda f α :=
- λ b s, s <$> x
- def uncheck (x : yoneda f α) : f α :=
- x α id
- def uncheck_check (x : f α) : uncheck (check x) = x :=
- begin
- simp [check, uncheck, is_lawful_functor.id_map]
- end
- def check_uncheck (x : yoneda f α) : check (uncheck x) = x :=
- begin
- simp [check, uncheck],
- funext,
- apply free_theorem (@uncheck f _ _)
- end
- @[reducible] def coyoneda := lan id
- def cocheck (x : f α) : coyoneda f α :=
- ⟨α, ⟨id, x⟩⟩
- def councheck (x : coyoneda f α) : f α :=
- x.2.1 <$> x.2.2
- def councheck_cocheck (x : f α) : councheck (cocheck x) = x :=
- begin
- simp [cocheck, councheck, is_lawful_functor.id_map]
- end
- def cocheck_councheck (x : coyoneda f α) : cocheck (councheck x) = x :=
- begin
- simp [councheck],
- rw ←free_theorem (@cocheck f _ _),
- simp [cocheck, functor.map, mapl]
- end
- end yoneda
- structure {u v} iso (α : Type u) (β : Type v) :=
- (f : α → β) (g : β → α) (gf : Π x, g (f x) = x) (fg : Π x, f (g x) = x)
- namespace iso
- def inv {α β} (i : iso α β) : iso β α :=
- ⟨i.g, i.f, i.fg, i.gf⟩
- def comp {α β γ} (i : iso α β) (j : iso β γ) : iso α γ :=
- ⟨j.f ∘ i.f, i.g ∘ j.g, by simp [j.gf, i.gf], by simp [i.fg, j.fg]⟩
- universes u v w
- variables {f : Type u → Type v} {g : Type u → Type w} (i : Π {α}, iso (f α) (g α))
- def imap [functor f] {α β : Type u} (s : α → β) (x : g α) : g β :=
- i.f $ s <$> i.g x
- def ipure [applicative f] {α : Type u} (x : α) : g α :=
- i.f $ pure x
- def iseq [applicative f] {α β : Type u} (s : g (α → β)) (x : g α) : g β :=
- i.f $ i.g s <*> i.g x
- def ibind [monad f] {α β : Type u} (x : g α) (s : α → g β) : g β :=
- i.f $ i.g x >>= i.g ∘ s
- @[priority std.priority.default-1]
- instance functor [functor f] : functor g :=
- { map := @imap f g @i _ }
- -- @[priority std.priority.default-1]
- -- instance is_lawful_functor [functor f] : is_lawful_functor g :=
- -- { id_map :=
- -- begin
- -- intros,
- -- simp [imap, is_lawful_functor.id_map, i.fg]
- -- end,
- -- comp_map :=
- -- begin
- -- intros,
- -- simp [imap, i.gf],
- -- rw is_lawful_functor.comp_map
- -- end }
- @[priority std.priority.default-1]
- instance applicative [applicative f] : applicative g :=
- { pure := @ipure f g @i _,
- seq := @iseq f g @i _ }
- -- @[priority std.priority.default-1]
- -- instance is_lawful_applicative [is_lawful_applicative f] : is_lawful_applicative g :=
- -- { pure_seq_eq_map := by intros; simp,
- -- id_map :=
- -- begin
- -- intros,
- -- simp [ipure, iseq, i.gf],
- -- simp [is_lawful_applicative.pure_seq_eq_map, is_lawful_functor.id_map, i.fg]
- -- end,
- -- map_pure :=
- -- begin
- -- intros,
- -- simp [ipure, iseq, i.gf],
- -- simp [is_lawful_applicative.pure_seq_eq_map, is_lawful_applicative.map_pure]
- -- end,
- -- seq_pure :=
- -- begin
- -- intros,
- -- simp [ipure, iseq, i.gf],
- -- simp [is_lawful_applicative.pure_seq_eq_map, is_lawful_applicative.seq_pure]
- -- end,
- -- seq_assoc :=
- -- begin
- -- intros,
- -- simp [ipure, iseq, i.gf],
- -- simp [is_lawful_applicative.pure_seq_eq_map, is_lawful_applicative.seq_assoc]
- -- end }
- @[priority std.priority.default-1]
- instance monad [monad f] : monad g :=
- { pure := @ipure f g @i _,
- bind := @ibind f g @i _ }
- -- @[priority std.priority.default-1]
- -- instance is_lawful_monad [is_lawful_monad f] : is_lawful_monad g :=
- -- { id_map :=
- -- begin
- -- intros,
- -- simp [ipure, ibind, i.gf],
- -- rw monad.bind_pure_comp_eq_map,
- -- simp [is_lawful_functor.id_map, i.fg]
- -- end,
- -- pure_bind :=
- -- begin
- -- intros,
- -- simp [ipure, ibind, i.gf],
- -- simp [is_lawful_monad.pure_bind, i.fg]
- -- end,
- -- bind_assoc :=
- -- begin
- -- intros,
- -- simp [ibind, i.gf],
- -- simp [is_lawful_monad.bind_assoc]
- -- end }
- end iso
- section yoneda_iso
- variables (f : Type → Type) [functor f] [is_lawful_functor f] ⦃α : Type⦄
- def yoneda_iso : iso (f α) (yoneda f α) :=
- ⟨check, uncheck, uncheck_check, check_uncheck⟩
- def coyoneda_iso : iso (f α) (coyoneda f α) :=
- ⟨cocheck, councheck, councheck_cocheck, cocheck_councheck⟩
- def yoco_iso : iso (yoneda f α) (coyoneda f α) :=
- (@yoneda_iso f _ _ α).inv.comp (@coyoneda_iso f _ _ α)
- end yoneda_iso
- -- instance {f} [applicative f] : applicative (yoneda f) := iso.applicative (yoneda_iso f)
- -- instance {f} [applicative f] : applicative (coyoneda f) := iso.applicative (coyoneda_iso f)
- -- instance {f} [monad f] : monad (yoneda f) := iso.monad (yoneda_iso f)
- -- instance {f} [monad f] : monad (coyoneda f) := iso.monad (coyoneda_iso f)
- section naturality_proofs
- variables {f : Type → Type} [functor f] [is_lawful_functor f]
- def natural_check : natural (@check f _ _) :=
- begin
- unfold natural, intros,
- dsimp [check, functor.map, mapr],
- funext,
- rw is_lawful_functor.comp_map
- end
- def natural_uncheck : natural (@uncheck f _ _) :=
- begin
- unfold natural, intros,
- dsimp [uncheck, functor.map, mapr],
- admit -- ← stuck here
- end
- def natural_cocheck : natural (@cocheck f _ _) :=
- begin
- unfold natural, intros,
- dsimp [cocheck, functor.map, mapl],
- admit -- ← stuck here
- end
- def natural_councheck : natural (@councheck f _ _) :=
- begin
- unfold natural, intros,
- dsimp [councheck, functor.map, mapl],
- rw ←is_lawful_functor.comp_map
- end
- end naturality_proofs
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement