From HoTT Require Import TruncType ExcludedMiddle Modalities.ReflectiveSubuniverse abstract_algebra.
[Loading ML file number_string_notation_plugin.cmxs (using legacy method) ... done]
From HoTT Require Import Universes.Smallness.
From HoTT Require Import Colimits.Quotient.
From HoTT Require Import HSet.

Local Close Scope trunc_scope.
Local Open Scope hprop_scope.

(** This file contains a definition of ordinals and some fundamental results,
    roughly following the presentation in the HoTT book. *)


(** * Well-foundedness *)

Inductive Accessible {A} (R : Lt A) (a : A) :=
  acc : (forall b, b < a -> Accessible R b) -> Accessible R a.

Instance ishprop_Accessible `{Funext} {A} (R : Lt A) (a : A) :
  IsHProp (Accessible R a).
H: Funext
A: Type
R: Lt A
a: A
IsHProp (Accessible R a)
Proof.
H: Funext
A: Type
R: Lt A
a: A
IsHProp (Accessible R a)
  apply hprop_allpath.
H: Funext
A: Type
R: Lt A
a: A
forall x y : Accessible R a, x = y
  intros acc1.
H: Funext
A: Type
R: Lt A
a: A
acc1: Accessible R a
forall y : Accessible R a, acc1 = y induction acc1 as [a acc1' IH].
H: Funext
A: Type
R: Lt A
a: A
acc1': forall b : A, b < a -> Accessible R b
IH: forall (b : A) (l : b < a) 
(y : Accessible R b), acc1' b l = y
forall y : Accessible R a, acc R a acc1' = y
  intros [acc2'].
H: Funext
A: Type
R: Lt A
a: A
acc1': forall b : A, b < a -> Accessible R b
IH: forall (b : A) (l : b < a) 
(y : Accessible R b), acc1' b l = y
acc2': forall b : A, b < a -> Accessible R b
acc R a acc1' = acc R a acc2' apply ap.
H: Funext
A: Type
R: Lt A
a: A
acc1': forall b : A, b < a -> Accessible R b
IH: forall (b : A) (l : b < a) 
(y : Accessible R b), acc1' b l = y
acc2': forall b : A, b < a -> Accessible R b
acc1' = acc2'
  apply path_forall; intros b.
H: Funext
A: Type
R: Lt A
a: A
acc1': forall b : A, b < a -> Accessible R b
IH: forall (b : A) (l : b < a) 
(y : Accessible R b), acc1' b l = y
acc2': forall b : A, b < a -> Accessible R b
b: A
acc1' b = acc2' b apply path_forall; intros Hb.
H: Funext
A: Type
R: Lt A
a: A
acc1': forall b : A, b < a -> Accessible R b
IH: forall (b : A) (l : b < a) 
(y : Accessible R b), acc1' b l = y
acc2': forall b : A, b < a -> Accessible R b
b: A
Hb: b < a
acc1' b Hb = acc2' b Hb
  apply IH.
Qed.

Class WellFounded {A} (R : Relation A) :=
  well_foundedness : forall a : A, Accessible R a.

Instance ishprop_WellFounded `{Funext} {A} (R : Relation A) :
  IsHProp (WellFounded R).
H: Funext
A: Type
R: Relation A
IsHProp (WellFounded R)
Proof.
H: Funext
A: Type
R: Relation A
IsHProp (WellFounded R)
  apply hprop_allpath; intros H1 H2.
H: Funext
A: Type
R: Relation A
H1, H2: WellFounded R
H1 = H2
  apply path_forall; intros a.
H: Funext
A: Type
R: Relation A
H1, H2: WellFounded R
a: A
H1 a = H2 a
  apply path_ishprop.
Qed.

(** * Extensionality *)

Class Extensional {A} (R : Lt A) :=
  extensionality : forall a b : A, (forall c : A, c < a <-> c < b) -> a = b.

Instance ishprop_Extensional `{Funext} {A} `{IsHSet A} (R : Relation A)
  : IsHProp (Extensional R).
H: Funext
A: Type
IsHSet0: IsHSet A
R: Relation A
IsHProp (Extensional R)
Proof.
H: Funext
A: Type
IsHSet0: IsHSet A
R: Relation A
IsHProp (Extensional R) unfold Extensional.
H: Funext
A: Type
IsHSet0: IsHSet A
R: Relation A
IsHProp
  (forall a b : A,
   (forall c : A, c < a <-> c < b) -> a = b) exact _. Qed.

(** * Ordinals *)

Class IsOrdinal@{carrier relation} (A : Type@{carrier}) (R : Relation@{carrier relation} A) := {
  ordinal_is_hset :: IsHSet A ;
  ordinal_relation_is_mere :: is_mere_relation A R ;
  ordinal_extensionality :: Extensional R ;
  ordinal_well_foundedness :: WellFounded R ;
  ordinal_transitivity :: Transitive R ;
}.

Instance ishprop_IsOrdinal `{Funext} A R
  : IsHProp (IsOrdinal A R).
H: Funext
A: Type
R: Relation A
IsHProp (IsOrdinal A R)
Proof.
H: Funext
A: Type
R: Relation A
IsHProp (IsOrdinal A R)
  eapply istrunc_equiv_istrunc.
H: Funext
A: Type
R: Relation A
?A <~> IsOrdinal A R
H: Funext
A: Type
R: Relation A
IsHProp ?A {
H: Funext
A: Type
R: Relation A
?A <~> IsOrdinal A R
    issig.
  }
H: Funext
A: Type
R: Relation A
IsHProp
  {_ : IsHSet A &
  {_ : is_mere_relation A R &
  {_ : Extensional R &
  {_ : WellFounded R & Transitive R}}}}
  unfold Transitive.
H: Funext
A: Type
R: Relation A
IsHProp
  {_ : IsHSet A &
  {_ : is_mere_relation A R &
  {_ : Extensional R &
  {_ : WellFounded R &
  forall x y z : A, R x y -> R y z -> R x z}}}} exact _.
Qed.

Record Ordinal@{carrier relation +} :=
  { ordinal_carrier : Type@{carrier}
    ; ordinal_relation :: Lt@{carrier relation} ordinal_carrier
    ; ordinal_property :: IsOrdinal@{carrier relation} ordinal_carrier (<)
  }.

Coercion ordinal_as_hset (A : Ordinal) : HSet
  := Build_HSet (ordinal_carrier A).

Instance irreflexive_ordinal_relation A R
  : IsOrdinal A R -> Irreflexive R.
A: Type
R: Relation A
IsOrdinal A R -> Irreflexive R
Proof.
A: Type
R: Relation A
IsOrdinal A R -> Irreflexive R
  intros is_ordinal a H.
A: Type
R: Relation A
is_ordinal: IsOrdinal A R
a: A
H: R a a
Empty
  induction (well_foundedness a) as [a _ IH].
A: Type
R: Relation A
is_ordinal: IsOrdinal A R
a: A
H: R a a
IH: forall b : A, b < a -> R b b -> Empty
Empty
  apply (IH a); assumption.
Qed.

Definition TypeWithRelation
  := { A : Type & Relation A }.

Coercion ordinal_as_type_with_relation (A : Ordinal) : TypeWithRelation
  := (A : Type; (<)).

(** * Paths in Ordinal *)

Definition equiv_Ordinal_to_sig
  : Ordinal <~> { R : { A : Type & Relation A } & IsOrdinal _ R.2 }.
Ordinal <~>
{R : {A : Type & Relation A} & IsOrdinal R.1 R.2}
Proof.
Ordinal <~>
{R : {A : Type & Relation A} & IsOrdinal R.1 R.2}
  transitivity { A : Type & { R : Relation A & IsOrdinal A R } }.
Ordinal <~>
{A : Type & {R : Relation A & IsOrdinal A R}}
{A : Type & {R : Relation A & IsOrdinal A R}} <~>
{R : {A : Type & Relation A} & IsOrdinal R.1 R.2} {
Ordinal <~>
{A : Type & {R : Relation A & IsOrdinal A R}}
    symmetry.
{A : Type & {R : Relation A & IsOrdinal A R}} <~>
Ordinal issig.
  }
{A : Type & {R : Relation A & IsOrdinal A R}} <~>
{R : {A : Type & Relation A} & IsOrdinal R.1 R.2}
  apply equiv_sigma_assoc'.
Defined.

Definition Isomorphism : TypeWithRelation -> TypeWithRelation -> Type
  := fun '(A; R__A) '(B; R__B) =>
       { f : A <~> B & forall a a', R__A a a' <-> R__B (f a) (f a') }.

Instance isomorphism_id : Reflexive Isomorphism.
Reflexive Isomorphism
Proof.
Reflexive Isomorphism intros A.
A: TypeWithRelation
Isomorphism A A exists equiv_idmap.
A: TypeWithRelation
forall a a' : A.1,
A.2 a a' <-> A.2 (1%equiv a) (1%equiv a') cbn.
A: TypeWithRelation
forall a a' : A.1, A.2 a a' <-> A.2 a a' intros a a'.
A: TypeWithRelation
a, a': A.1
A.2 a a' <-> A.2 a a' reflexivity. Qed.

Lemma isomorphism_inverse
  : forall A B, Isomorphism A B -> Isomorphism B A.
forall A B : TypeWithRelation,
Isomorphism A B -> Isomorphism B A
Proof.
forall A B : TypeWithRelation,
Isomorphism A B -> Isomorphism B A
  intros [A R__A] [B R__B] [f H].
A: Type
R__A: Relation A
B: Type
R__B: Relation B
f: A <~> B
H: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
Isomorphism (B; R__B) (A; R__A)
  exists (equiv_inverse f).
A: Type
R__A: Relation A
B: Type
R__B: Relation B
f: A <~> B
H: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
forall a a' : B,
R__B a a' <-> R__A (f^-1%equiv a) (f^-1%equiv a')
  intros b b'.
A: Type
R__A: Relation A
B: Type
R__B: Relation B
f: A <~> B
H: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
b, b': B
R__B b b' <-> R__A (f^-1%equiv b) (f^-1%equiv b')
  cbn.
A: Type
R__A: Relation A
B: Type
R__B: Relation B
f: A <~> B
H: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
b, b': B
R__B b b' <-> R__A (f^-1 b) (f^-1 b')
  rewrite <- (eisretr f b).
A: Type
R__A: Relation A
B: Type
R__B: Relation B
f: A <~> B
H: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
b, b': B
R__B (f (f^-1 b)) b' <->
R__A (f^-1 (f (f^-1 b))) (f^-1 b') set (a := f^-1 b).
A: Type
R__A: Relation A
B: Type
R__B: Relation B
f: A <~> B
H: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
b, b': B
a:= f^-1 b: A
R__B (f a) b' <-> R__A (f^-1 (f a)) (f^-1 b') rewrite eissect.
A: Type
R__A: Relation A
B: Type
R__B: Relation B
f: A <~> B
H: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
b, b': B
a:= f^-1 b: A
R__B (f a) b' <-> R__A a (f^-1 b')
  rewrite <- (eisretr f b').
A: Type
R__A: Relation A
B: Type
R__B: Relation B
f: A <~> B
H: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
b, b': B
a:= f^-1 b: A
R__B (f a) (f (f^-1 b')) <->
R__A a (f^-1 (f (f^-1 b'))) set (a' := f^-1 b').
A: Type
R__A: Relation A
B: Type
R__B: Relation B
f: A <~> B
H: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
b, b': B
a:= f^-1 b: A
a':= f^-1 b': A
R__B (f a) (f a') <-> R__A a (f^-1 (f a')) rewrite eissect.
A: Type
R__A: Relation A
B: Type
R__B: Relation B
f: A <~> B
H: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
b, b': B
a:= f^-1 b: A
a':= f^-1 b': A
R__B (f a) (f a') <-> R__A a a'
  (* We don't apply the symmetry tactic because that would introduce bad universe constraints *)
  split; apply H.
Defined.

(** We state this first without using [Transitive] to allow more general universe variables. *)
Lemma transitive_Isomorphism
  : forall A B C, Isomorphism A B -> Isomorphism B C -> Isomorphism A C.
forall A B C : TypeWithRelation,
Isomorphism A B -> Isomorphism B C -> Isomorphism A C
Proof.
forall A B C : TypeWithRelation,
Isomorphism A B -> Isomorphism B C -> Isomorphism A C
  intros [A R__A] [B R__B] [C R__C].
A: Type
R__A: Relation A
B: Type
R__B: Relation B
C: Type
R__C: Relation C
Isomorphism (A; R__A) (B; R__B) ->
Isomorphism (B; R__B) (C; R__C) ->
Isomorphism (A; R__A) (C; R__C)
  intros [f Hf] [g Hg].
A: Type
R__A: Relation A
B: Type
R__B: Relation B
C: Type
R__C: Relation C
f: A <~> B
Hf: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
g: B <~> C
Hg: forall a a' : B, R__B a a' <-> R__C (g a) (g a')
Isomorphism (A; R__A) (C; R__C)
  exists (equiv_compose' g f).
A: Type
R__A: Relation A
B: Type
R__B: Relation B
C: Type
R__C: Relation C
f: A <~> B
Hf: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
g: B <~> C
Hg: forall a a' : B, R__B a a' <-> R__C (g a) (g a')
forall a a' : A,
R__A a a' <-> R__C ((g oE f) a) ((g oE f) a')
  intros a a'.
A: Type
R__A: Relation A
B: Type
R__B: Relation B
C: Type
R__C: Relation C
f: A <~> B
Hf: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
g: B <~> C
Hg: forall a a' : B, R__B a a' <-> R__C (g a) (g a')
a, a': A
R__A a a' <-> R__C ((g oE f) a) ((g oE f) a')
  split.
A: Type
R__A: Relation A
B: Type
R__B: Relation B
C: Type
R__C: Relation C
f: A <~> B
Hf: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
g: B <~> C
Hg: forall a a' : B, R__B a a' <-> R__C (g a) (g a')
a, a': A
R__A a a' -> R__C ((g oE f) a) ((g oE f) a')
A: Type
R__A: Relation A
B: Type
R__B: Relation B
C: Type
R__C: Relation C
f: A <~> B
Hf: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
g: B <~> C
Hg: forall a a' : B, R__B a a' <-> R__C (g a) (g a')
a, a': A
R__C ((g oE f) a) ((g oE f) a') -> R__A a a'
  -
A: Type
R__A: Relation A
B: Type
R__B: Relation B
C: Type
R__C: Relation C
f: A <~> B
Hf: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
g: B <~> C
Hg: forall a a' : B, R__B a a' <-> R__C (g a) (g a')
a, a': A
R__A a a' -> R__C ((g oE f) a) ((g oE f) a') intros a_a'.
A: Type
R__A: Relation A
B: Type
R__B: Relation B
C: Type
R__C: Relation C
f: A <~> B
Hf: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
g: B <~> C
Hg: forall a a' : B, R__B a a' <-> R__C (g a) (g a')
a, a': A
a_a': R__A a a'
R__C ((g oE f) a) ((g oE f) a') apply Hg.
A: Type
R__A: Relation A
B: Type
R__B: Relation B
C: Type
R__C: Relation C
f: A <~> B
Hf: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
g: B <~> C
Hg: forall a a' : B, R__B a a' <-> R__C (g a) (g a')
a, a': A
a_a': R__A a a'
R__B (f a) (f a') apply Hf.
A: Type
R__A: Relation A
B: Type
R__B: Relation B
C: Type
R__C: Relation C
f: A <~> B
Hf: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
g: B <~> C
Hg: forall a a' : B, R__B a a' <-> R__C (g a) (g a')
a, a': A
a_a': R__A a a'
R__A a a' exact a_a'.
  -
A: Type
R__A: Relation A
B: Type
R__B: Relation B
C: Type
R__C: Relation C
f: A <~> B
Hf: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
g: B <~> C
Hg: forall a a' : B, R__B a a' <-> R__C (g a) (g a')
a, a': A
R__C ((g oE f) a) ((g oE f) a') -> R__A a a' intros gfa_gfa'.
A: Type
R__A: Relation A
B: Type
R__B: Relation B
C: Type
R__C: Relation C
f: A <~> B
Hf: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
g: B <~> C
Hg: forall a a' : B, R__B a a' <-> R__C (g a) (g a')
a, a': A
gfa_gfa': R__C ((g oE f) a) ((g oE f) a')
R__A a a' apply Hf.
A: Type
R__A: Relation A
B: Type
R__B: Relation B
C: Type
R__C: Relation C
f: A <~> B
Hf: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
g: B <~> C
Hg: forall a a' : B, R__B a a' <-> R__C (g a) (g a')
a, a': A
gfa_gfa': R__C ((g oE f) a) ((g oE f) a')
R__B (f a) (f a') apply Hg.
A: Type
R__A: Relation A
B: Type
R__B: Relation B
C: Type
R__C: Relation C
f: A <~> B
Hf: forall a a' : A, R__A a a' <-> R__B (f a) (f a')
g: B <~> C
Hg: forall a a' : B, R__B a a' <-> R__C (g a) (g a')
a, a': A
gfa_gfa': R__C ((g oE f) a) ((g oE f) a')
R__C (g (f a)) (g (f a')) exact gfa_gfa'.
Defined.

Instance isomorphism_compose_backwards : Transitive Isomorphism
  := transitive_Isomorphism.

Definition equiv_path_Ordinal `{Univalence} (A B : Ordinal)
  : Isomorphism A B <~> A = B.
H: Univalence
A, B: Ordinal
Isomorphism A B <~> A = B
Proof.
H: Univalence
A, B: Ordinal
Isomorphism A B <~> A = B
  unfold Isomorphism.
H: Univalence
A, B: Ordinal
{f : A.1 <~> B.1 &
forall a a' : A.1, A.2 a a' <-> B.2 (f a) (f a')} <~>
A = B rapply symmetric_equiv.
H: Univalence
A, B: Ordinal
A = B <~>
{f : A.1 <~> B.1 &
forall a a' : A.1, A.2 a a' <-> B.2 (f a) (f a')}
  transitivity (equiv_Ordinal_to_sig A = equiv_Ordinal_to_sig B).
H: Univalence
A, B: Ordinal
A = B <~>
equiv_Ordinal_to_sig A = equiv_Ordinal_to_sig B
H: Univalence
A, B: Ordinal
equiv_Ordinal_to_sig A = equiv_Ordinal_to_sig B <~>
{f : A.1 <~> B.1 &
forall a a' : A.1, A.2 a a' <-> B.2 (f a) (f a')} {
H: Univalence
A, B: Ordinal
A = B <~>
equiv_Ordinal_to_sig A = equiv_Ordinal_to_sig B
    apply equiv_ap'.
  }
H: Univalence
A, B: Ordinal
equiv_Ordinal_to_sig A = equiv_Ordinal_to_sig B <~>
{f : A.1 <~> B.1 &
forall a a' : A.1, A.2 a a' <-> B.2 (f a) (f a')}
  transitivity ((equiv_Ordinal_to_sig A).1 = (equiv_Ordinal_to_sig B).1).
H: Univalence
A, B: Ordinal
equiv_Ordinal_to_sig A = equiv_Ordinal_to_sig B <~>
(equiv_Ordinal_to_sig A).1 =
(equiv_Ordinal_to_sig B).1
H: Univalence
A, B: Ordinal
(equiv_Ordinal_to_sig A).1 =
(equiv_Ordinal_to_sig B).1 <~>
{f : A.1 <~> B.1 &
forall a a' : A.1, A.2 a a' <-> B.2 (f a) (f a')} {
H: Univalence
A, B: Ordinal
equiv_Ordinal_to_sig A = equiv_Ordinal_to_sig B <~>
(equiv_Ordinal_to_sig A).1 =
(equiv_Ordinal_to_sig B).1
    exists pr1_path.
H: Univalence
A, B: Ordinal
IsEquiv pr1_path exact (isequiv_pr1_path_hprop _ _).
  }
H: Univalence
A, B: Ordinal
(equiv_Ordinal_to_sig A).1 =
(equiv_Ordinal_to_sig B).1 <~>
{f : A.1 <~> B.1 &
forall a a' : A.1, A.2 a a' <-> B.2 (f a) (f a')}
  transitivity (exist Relation A (<) = exist Relation B (<)).
H: Univalence
A, B: Ordinal
(equiv_Ordinal_to_sig A).1 =
(equiv_Ordinal_to_sig B).1 <~> (A; lt) = (B; lt)
H: Univalence
A, B: Ordinal
(A; lt) = (B; lt) <~>
{f : A.1 <~> B.1 &
forall a a' : A.1, A.2 a a' <-> B.2 (f a) (f a')} {
H: Univalence
A, B: Ordinal
(equiv_Ordinal_to_sig A).1 =
(equiv_Ordinal_to_sig B).1 <~> (A; lt) = (B; lt)
    reflexivity.
  }
H: Univalence
A, B: Ordinal
(A; lt) = (B; lt) <~>
{f : A.1 <~> B.1 &
forall a a' : A.1, A.2 a a' <-> B.2 (f a) (f a')}
  transitivity { p : A = B :> Type & p # (<) = (<) }.
H: Univalence
A, B: Ordinal
(A; lt) = (B; lt) <~>
{p : A = B & transport Relation p lt = lt}
H: Univalence
A, B: Ordinal
{p : A = B & transport Relation p lt = lt} <~>
{f : A.1 <~> B.1 &
forall a a' : A.1, A.2 a a' <-> B.2 (f a) (f a')} {
H: Univalence
A, B: Ordinal
(A; lt) = (B; lt) <~>
{p : A = B & transport Relation p lt = lt}
    symmetry.
H: Univalence
A, B: Ordinal
{p : A = B & transport Relation p lt = lt} <~>
(A; lt) = (B; lt)
    exact (equiv_path_sigma Relation
                            (exist Relation A (<))
                            (exist Relation B (<))).
  }
H: Univalence
A, B: Ordinal
{p : A = B & transport Relation p lt = lt} <~>
{f : A.1 <~> B.1 &
forall a a' : A.1, A.2 a a' <-> B.2 (f a) (f a')}
  srapply equiv_functor_sigma'.
H: Univalence
A, B: Ordinal
A = B <~> (A.1 <~> B.1)
H: Univalence
A, B: Ordinal
forall a : A = B,
(fun p : A = B => transport Relation p lt = lt) a <~>
(fun f : A.1 <~> B.1 =>
 forall a0 a' : A.1, A.2 a0 a' <-> B.2 (f a0) (f a'))
  (?f a)
  -
H: Univalence
A, B: Ordinal
A = B <~> (A.1 <~> B.1) exact (equiv_equiv_path A B).
  -
H: Univalence
A, B: Ordinal
forall a : A = B,
(fun p : A = B => transport Relation p lt = lt) a <~>
(fun f : A.1 <~> B.1 =>
 forall a0 a' : A.1, A.2 a0 a' <-> B.2 (f a0) (f a'))
  (equiv_equiv_path A B a) cbn.
H: Univalence
A, B: Ordinal
forall a : ordinal_carrier A = ordinal_carrier B,
transport Relation a lt = lt <~>
(forall a0 a' : ordinal_carrier A,
 a0 < a' <->
 transport idmap a a0 < transport idmap a a') intros p.
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
transport Relation p lt = lt <~>
(forall a a' : ordinal_carrier A,
 a < a' <-> transport idmap p a < transport idmap p a')
    napply equiv_iff_hprop.
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
IsHProp (transport Relation p lt = lt)
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
IsHProp
  (forall a a' : ordinal_carrier A,
   a < a' <->
   transport idmap p a < transport idmap p a')
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
transport Relation p lt = lt ->
forall a a' : ordinal_carrier A,
a < a' <-> transport idmap p a < transport idmap p a'
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
(forall a a' : ordinal_carrier A,
 a < a' <-> transport idmap p a < transport idmap p a') ->
transport Relation p lt = lt
    +
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
IsHProp (transport Relation p lt = lt) apply (istrunc_equiv_istrunc (forall b b' : B, (p # (<)) b b' = (b < b'))).
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
(forall b b' : B,
 transport Relation p lt b b' = (b < b')) <~>
transport Relation p lt = lt
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
IsHProp
  (forall b b' : B,
   transport Relation p lt b b' = (b < b')) {
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
(forall b b' : B,
 transport Relation p lt b b' = (b < b')) <~>
transport Relation p lt = lt
        transitivity (forall b : B, (p # lt) b = lt b).
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
(forall b b' : B,
 transport Relation p lt b b' = (b < b')) <~>
(forall b : B, transport Relation p lt b = lt b)
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
(forall b : B, transport Relation p lt b = lt b) <~>
transport Relation p lt = lt {
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
(forall b b' : B,
 transport Relation p lt b b' = (b < b')) <~>
(forall b : B, transport Relation p lt b = lt b)
          apply equiv_functor_forall_id; intros b.
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
b: B
(forall b' : B,
 transport Relation p lt b b' = (b < b')) <~>
transport Relation p lt b = lt b apply equiv_path_arrow.
        }
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
(forall b : B, transport Relation p lt b = lt b) <~>
transport Relation p lt = lt
        apply equiv_path_arrow.
      }
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
IsHProp
  (forall b b' : B,
   transport Relation p lt b b' = (b < b'))
      exact _.
    +
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
IsHProp
  (forall a a' : ordinal_carrier A,
   a < a' <->
   transport idmap p a < transport idmap p a') exact _. 
    +
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
transport Relation p lt = lt ->
forall a a' : ordinal_carrier A,
a < a' <-> transport idmap p a < transport idmap p a' intros <- a a'.
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
a, a': ordinal_carrier A
a < a' <->
transport Relation p lt (transport idmap p a)
  (transport idmap p a')
      rewrite transport_arrow.
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
a, a': ordinal_carrier A
a < a' <->
transport (fun x : Type => x -> Type) p
  (lt (transport idmap p^ (transport idmap p a)))
  (transport idmap p a') rewrite transport_arrow_toconst.
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
a, a': ordinal_carrier A
a < a' <->
transport idmap p^ (transport idmap p a) <
transport idmap p^ (transport idmap p a')
      repeat rewrite transport_Vp.
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
a, a': ordinal_carrier A
a < a' <-> a < a' reflexivity.
    +
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
(forall a a' : ordinal_carrier A,
 a < a' <-> transport idmap p a < transport idmap p a') ->
transport Relation p lt = lt intros H0.
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
H0: forall a a' : ordinal_carrier A,
a < a' <->
transport idmap p a < transport idmap p a'
transport Relation p lt = lt
      by_extensionality b.
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
H0: forall a a' : ordinal_carrier A,
a < a' <->
transport idmap p a < transport idmap p a'
b: ordinal_carrier B
transport Relation p lt b = lt b by_extensionality b'.
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
H0: forall a a' : ordinal_carrier A,
a < a' <->
transport idmap p a < transport idmap p a'
b, b': ordinal_carrier B
transport Relation p lt b b' = (b < b')
      rewrite transport_arrow.
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
H0: forall a a' : ordinal_carrier A,
a < a' <->
transport idmap p a < transport idmap p a'
b, b': ordinal_carrier B
transport (fun x : Type => x -> Type) p
  (lt (transport idmap p^ b)) b' = (b < b') rewrite transport_arrow_toconst.
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
H0: forall a a' : ordinal_carrier A,
a < a' <->
transport idmap p a < transport idmap p a'
b, b': ordinal_carrier B
(transport idmap p^ b < transport idmap p^ b') =
(b < b')
      apply path_iff_ishprop_uncurried.
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
H0: forall a a' : ordinal_carrier A,
a < a' <->
transport idmap p a < transport idmap p a'
b, b': ordinal_carrier B
transport idmap p^ b < transport idmap p^ b' <->
b < b'
      specialize (H0 (transport idmap p^ b) (transport idmap p^ b')).
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
b, b': ordinal_carrier B
H0: transport idmap p^ b < transport idmap p^ b' <->
transport idmap p (transport idmap p^ b) <
transport idmap p (transport idmap p^ b')
transport idmap p^ b < transport idmap p^ b' <->
b < b'
      repeat rewrite transport_pV in H0.
H: Univalence
A, B: Ordinal
p: ordinal_carrier A = ordinal_carrier B
b, b': ordinal_carrier B
H0: transport idmap p^ b < transport idmap p^ b' <->
b < b'
transport idmap p^ b < transport idmap p^ b' <->
b < b' exact H0.
Qed.

Lemma path_Ordinal `{Univalence} (A B : Ordinal)
  : forall f : A <~> B,
    (forall a a' : A, a < a' <-> f a < f a')
    -> A = B.
H: Univalence
A, B: Ordinal
forall f : A <~> B,
(forall a a' : A, a < a' <-> f a < f a') -> A = B
Proof.
H: Univalence
A, B: Ordinal
forall f : A <~> B,
(forall a a' : A, a < a' <-> f a < f a') -> A = B
  intros f H0.
H: Univalence
A, B: Ordinal
f: A <~> B
H0: forall a a' : A, a < a' <-> f a < f a'
A = B apply equiv_path_Ordinal.
H: Univalence
A, B: Ordinal
f: A <~> B
H0: forall a a' : A, a < a' <-> f a < f a'
Isomorphism A B exists f.
H: Univalence
A, B: Ordinal
f: A <~> B
H0: forall a a' : A, a < a' <-> f a < f a'
forall a a' : A.1, A.2 a a' <-> B.2 (f a) (f a') exact H0.
Qed.

Lemma trichotomy_ordinal `{ExcludedMiddle} {A : Ordinal} (a b : A)
  : a < b \/ a = b \/ b < a.
H: ExcludedMiddle
A: Ordinal
a, b: A
a < b \/ a = b \/ b < a
Proof.
H: ExcludedMiddle
A: Ordinal
a, b: A
a < b \/ a = b \/ b < a
  revert b.
H: ExcludedMiddle
A: Ordinal
a: A
forall b : A, a < b \/ a = b \/ b < a induction (well_foundedness a) as [a _ IHa].
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
forall b : A, a < b \/ a = b \/ b < a intros b.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
a < b \/ a = b \/ b < a
  induction (well_foundedness b) as [b _ IHb].
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
a < b \/ a = b \/ b < a
  destruct (LEM (merely (exists b', b' < b /\ (a = b' \/ a < b')))) as [H1 | H1]; try exact _.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a < b \/ a = b \/ b < a
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a < b \/ a = b \/ b < a
  -
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a < b \/ a = b \/ b < a revert H1.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
merely {b' : A & ((b' < b) * (a = b' \/ a < b'))%type} ->
a < b \/ a = b \/ b < a rapply Trunc_rec.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
{b' : A & ((b' < b) * (a = b' \/ a < b'))%type} ->
a < b \/ a = b \/ b < a intros [b' [b'_b Hb']].
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
b': A
b'_b: b' < b
Hb': a = b' \/ a < b'
a < b \/ a = b \/ b < a
    revert Hb'.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
b': A
b'_b: b' < b
a = b' \/ a < b' -> a < b \/ a = b \/ b < a rapply Trunc_rec.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
b': A
b'_b: b' < b
(a = b') + (a < b') -> a < b \/ a = b \/ b < a intros [a_b' | b'_a].
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
b': A
b'_b: b' < b
a_b': a = b'
a < b \/ a = b \/ b < a
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A,
b < a ->
forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A,
b0 < b -> a < b0 \/ a = b0 \/ b0 < a
b': A
b'_b: b' < b
b'_a: a < b'
a < b \/ a = b \/ b < a
    +
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
b': A
b'_b: b' < b
a_b': a = b'
a < b \/ a = b \/ b < a apply tr.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
b': A
b'_b: b' < b
a_b': a = b'
((a < b) + (a = b \/ b < a))%type left.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
b': A
b'_b: b' < b
a_b': a = b'
a < b rewrite a_b'.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
b': A
b'_b: b' < b
a_b': a = b'
b' < b exact b'_b.
    +
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
b': A
b'_b: b' < b
b'_a: a < b'
a < b \/ a = b \/ b < a apply tr.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
b': A
b'_b: b' < b
b'_a: a < b'
((a < b) + (a = b \/ b < a))%type left.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
b': A
b'_b: b' < b
b'_a: a < b'
a < b transitivity b'; assumption.
  -
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a < b \/ a = b \/ b < a destruct (LEM (merely (exists a', a' < a /\ (a' = b \/ b < a')))) as [H2 | H2]; try exact _.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
a < b \/ a = b \/ b < a
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
a < b \/ a = b \/ b < a
    +
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
a < b \/ a = b \/ b < a revert H2.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
merely {a' : A & ((a' < a) * (a' = b \/ b < a'))%type} ->
a < b \/ a = b \/ b < a rapply Trunc_rec.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
{a' : A & ((a' < a) * (a' = b \/ b < a'))%type} ->
a < b \/ a = b \/ b < a intros [a' [a'_a Ha']].
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a': A
a'_a: a' < a
Ha': a' = b \/ b < a'
a < b \/ a = b \/ b < a
      revert Ha'.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a': A
a'_a: a' < a
a' = b \/ b < a' -> a < b \/ a = b \/ b < a rapply Trunc_rec.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a': A
a'_a: a' < a
(a' = b) + (b < a') -> a < b \/ a = b \/ b < a intros [a'_b | b_a'].
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a': A
a'_a: a' < a
a'_b: a' = b
a < b \/ a = b \/ b < a
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A,
b < a ->
forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A,
b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a': A
a'_a: a' < a
b_a': b < a'
a < b \/ a = b \/ b < a
      *
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a': A
a'_a: a' < a
a'_b: a' = b
a < b \/ a = b \/ b < a apply tr.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a': A
a'_a: a' < a
a'_b: a' = b
((a < b) + (a = b \/ b < a))%type right.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a': A
a'_a: a' < a
a'_b: a' = b
a = b \/ b < a apply tr.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a': A
a'_a: a' < a
a'_b: a' = b
((a = b) + (b < a))%type right.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a': A
a'_a: a' < a
a'_b: a' = b
b < a rewrite <- a'_b.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a': A
a'_a: a' < a
a'_b: a' = b
a' < a exact a'_a.
      *
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a': A
a'_a: a' < a
b_a': b < a'
a < b \/ a = b \/ b < a apply tr.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a': A
a'_a: a' < a
b_a': b < a'
((a < b) + (a = b \/ b < a))%type right.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a': A
a'_a: a' < a
b_a': b < a'
a = b \/ b < a apply tr.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a': A
a'_a: a' < a
b_a': b < a'
((a = b) + (b < a))%type right.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
a': A
a'_a: a' < a
b_a': b < a'
b < a transitivity a'; assumption.
    +
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
a < b \/ a = b \/ b < a apply tr.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
((a < b) + (a = b \/ b < a))%type right.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
a = b \/ b < a apply tr.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
((a = b) + (b < a))%type left.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
a = b
      apply extensionality.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
forall c : A, c < a <-> c < b intros c.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c < a <-> c < b split.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c < a -> c < b
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c < b -> c < a
      *
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c < a -> c < b intros c_a.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_a: c < a
c < b apply LEM_to_DNE; try exact _.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_a: c < a
~~ (c < b) intros not_c_b.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_a: c < a
not_c_b: ~ (c < b)
Empty
        apply H2.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_a: c < a
not_c_b: ~ (c < b)
merely {a' : A & ((a' < a) * (a' = b \/ b < a'))%type} apply tr.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_a: c < a
not_c_b: ~ (c < b)
{a' : A & ((a' < a) * (a' = b \/ b < a'))%type} exists c.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_a: c < a
not_c_b: ~ (c < b)
((c < a) * (c = b \/ b < c))%type split.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_a: c < a
not_c_b: ~ (c < b)
c < a
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A,
b < a ->
forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A,
b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_a: c < a
not_c_b: ~ (c < b)
c = b \/ b < c
        --
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_a: c < a
not_c_b: ~ (c < b)
c < a exact c_a.
        --
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_a: c < a
not_c_b: ~ (c < b)
c = b \/ b < c refine (Trunc_rec _ (IHa c c_a b)).
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_a: c < a
not_c_b: ~ (c < b)
(c < b) + (c = b \/ b < c) -> c = b \/ b < c intros [c_b | H3].
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_a: c < a
not_c_b: ~ (c < b)
c_b: c < b
c = b \/ b < c
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A,
b < a ->
forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A,
b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_a: c < a
not_c_b: ~ (c < b)
H3: c = b \/ b < c
c = b \/ b < c
           ++
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_a: c < a
not_c_b: ~ (c < b)
c_b: c < b
c = b \/ b < c apply Empty_rec.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_a: c < a
not_c_b: ~ (c < b)
c_b: c < b
Empty exact (not_c_b c_b).
           ++
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_a: c < a
not_c_b: ~ (c < b)
H3: c = b \/ b < c
c = b \/ b < c exact H3.
      *
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c < b -> c < a intros c_b.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
c < a apply LEM_to_DNE; try exact _.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
~~ (c < a) intros not_c_a.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
Empty
        apply H1.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
merely {b' : A & ((b' < b) * (a = b' \/ a < b'))%type} apply tr.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
{b' : A & ((b' < b) * (a = b' \/ a < b'))%type} exists c.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
((c < b) * (a = c \/ a < c))%type split.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
c < b
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A,
b < a ->
forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A,
b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
a = c \/ a < c
        --
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
c < b exact c_b.
        --
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
a = c \/ a < c refine (Trunc_rec _ (IHb c c_b)).
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
(a < c) + (a = c \/ c < a) -> a = c \/ a < c intros [a_c | H3].
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
a_c: a < c
a = c \/ a < c
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A,
b < a ->
forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A,
b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
H3: a = c \/ c < a
a = c \/ a < c
           ++
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
a_c: a < c
a = c \/ a < c apply tr.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
a_c: a < c
((a = c) + (a < c))%type right.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
a_c: a < c
a < c exact a_c.
           ++
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
H3: a = c \/ c < a
a = c \/ a < c refine (Trunc_rec _ H3).
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
H3: a = c \/ c < a
(a = c) + (c < a) -> a = c \/ a < c intros [a_c | c_a].
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
H3: a = c \/ c < a
a_c: a = c
a = c \/ a < c
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A,
b < a ->
forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A,
b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
H3: a = c \/ c < a
c_a: c < a
a = c \/ a < c
              **
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
H3: a = c \/ c < a
a_c: a = c
a = c \/ a < c apply tr.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
H3: a = c \/ c < a
a_c: a = c
((a = c) + (a < c))%type left.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
H3: a = c \/ c < a
a_c: a = c
a = c exact a_c.
              **
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
H3: a = c \/ c < a
c_a: c < a
a = c \/ a < c apply tr.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
H3: a = c \/ c < a
c_a: c < a
((a = c) + (a < c))%type right.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
H3: a = c \/ c < a
c_a: c < a
a < c apply Empty_rec.
H: ExcludedMiddle
A: Ordinal
a: A
IHa: forall b : A, b < a -> forall b0 : A, b < b0 \/ b = b0 \/ b0 < b
b: A
IHb: forall b0 : A, b0 < b -> a < b0 \/ a = b0 \/ b0 < a
H1: ~
merely
  {b' : A & ((b' < b) * (a = b' \/ a < b'))%type}
H2: ~
merely
  {a' : A & ((a' < a) * (a' = b \/ b < a'))%type}
c: A
c_b: c < b
not_c_a: ~ (c < a)
H3: a = c \/ c < a
c_a: c < a
Empty exact (not_c_a c_a).
Qed.

Lemma ordinal_has_minimal_hsolutions {lem : ExcludedMiddle} (A : Ordinal) (P : A -> HProp)
  : merely (exists a, P a) -> merely (exists a, P a /\ forall b, P b -> a < b \/ a = b).
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
merely {a : A & P a} ->
merely
  {a : A &
  (P a * (forall b : A, P b -> a < b \/ a = b))%type}
Proof.
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
merely {a : A & P a} ->
merely
  {a : A &
  (P a * (forall b : A, P b -> a < b \/ a = b))%type}
  intros H'.
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
merely
  {a : A &
  (P a * (forall b : A, P b -> a < b \/ a = b))%type} eapply merely_destruct; try exact H'.
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
{a : A & P a} ->
merely
  {a : A &
  (P a * (forall b : A, P b -> a < b \/ a = b))%type}
  intros [a Ha].
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
merely
  {a : A &
  (P a * (forall b : A, P b -> a < b \/ a = b))%type} induction (well_foundedness a) as [a _ IH].
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
merely
  {a : A &
  (P a * (forall b : A, P b -> a < b \/ a = b))%type}
  destruct (LEM (merely (exists b, P b /\ b < a)) _) as [H|H].
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: merely {b : A & (P b * (b < a))%type}
merely
  {a : A &
  (P a * (forall b : A, P b -> a < b \/ a = b))%type}
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
merely
  {a : A &
  (P a * (forall b : A, P b -> a < b \/ a = b))%type}
  -
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: merely {b : A & (P b * (b < a))%type}
merely
  {a : A &
  (P a * (forall b : A, P b -> a < b \/ a = b))%type} eapply merely_destruct; try apply H.
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: merely {b : A & (P b * (b < a))%type}
{b : A & (P b * (b < a))%type} ->
merely
  {a : A &
  (P a * (forall b : A, P b -> a < b \/ a = b))%type} intros [b Hb].
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: merely {b : A & (P b * (b < a))%type}
b: A
Hb: (P b * (b < a))%type
merely
  {a : A &
  (P a * (forall b : A, P b -> a < b \/ a = b))%type} apply (IH b); apply Hb.
  -
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
merely
  {a : A &
  (P a * (forall b : A, P b -> a < b \/ a = b))%type} apply tr.
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
{a : A &
(P a * (forall b : A, P b -> a < b \/ a = b))%type} exists a.
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
(P a * (forall b : A, P b -> a < b \/ a = b))%type split; try exact Ha.
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
forall b : A, P b -> a < b \/ a = b intros b Hb.
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
a < b \/ a = b
    specialize (trichotomy_ordinal a b).
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
a < b \/ a = b \/ b < a -> a < b \/ a = b intros H1.
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
H1: a < b \/ a = b \/ b < a
a < b \/ a = b
    eapply merely_destruct; try exact H1.
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
H1: a < b \/ a = b \/ b < a
(a < b) + (a = b \/ b < a) -> a < b \/ a = b
    intros [H2|H2].
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
H1: a < b \/ a = b \/ b < a
H2: a < b
a < b \/ a = b
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
H1: a < b \/ a = b \/ b < a
H2: a = b \/ b < a
a < b \/ a = b {
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
H1: a < b \/ a = b \/ b < a
H2: a < b
a < b \/ a = b apply tr.
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
H1: a < b \/ a = b \/ b < a
H2: a < b
((a < b) + (a = b))%type by left. }
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
H1: a < b \/ a = b \/ b < a
H2: a = b \/ b < a
a < b \/ a = b
    eapply merely_destruct; try exact H2.
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
H1: a < b \/ a = b \/ b < a
H2: a = b \/ b < a
(a = b) + (b < a) -> a < b \/ a = b
    intros [H3|H3].
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
H1: a < b \/ a = b \/ b < a
H2: a = b \/ b < a
H3: a = b
a < b \/ a = b
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
H1: a < b \/ a = b \/ b < a
H2: a = b \/ b < a
H3: b < a
a < b \/ a = b {
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
H1: a < b \/ a = b \/ b < a
H2: a = b \/ b < a
H3: a = b
a < b \/ a = b apply tr.
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
H1: a < b \/ a = b \/ b < a
H2: a = b \/ b < a
H3: a = b
((a < b) + (a = b))%type by right. }
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
H1: a < b \/ a = b \/ b < a
H2: a = b \/ b < a
H3: b < a
a < b \/ a = b
    apply Empty_rec, H, tr.
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
H1: a < b \/ a = b \/ b < a
H2: a = b \/ b < a
H3: b < a
{b : A & (P b * (b < a))%type} exists b.
lem: ExcludedMiddle
A: Ordinal
P: A -> HProp
H': merely {a : A & P a}
a: A
Ha: P a
IH: forall b : A,
b < a ->
P b ->
merely
  {a : A &
  (P a *
   (forall b0 : A, P b0 -> a < b0 \/ a = b0))%type}
H: ~ merely {b : A & (P b * (b < a))%type}
b: A
Hb: P b
H1: a < b \/ a = b \/ b < a
H2: a = b \/ b < a
H3: b < a
(P b * (b < a))%type by split.
Qed.

(** * Simulations *)

(** We define the notion of simulations between arbitrary relations. For simplicity, most lemmas about simulations are formulated for ordinals only, even if they do not need all properties of ordinals. The only exception is [isordinal_simulation] which can be used to prove that a relation is an ordinal. *)

Class IsSimulation {A B : Type} {R__A : Lt A} {R__B : Lt B} (f : A -> B) :=
  { simulation_is_hom {a a'}
    : a < a' -> f a < f a'
    ; simulation_is_merely_minimal {a b}
      : b < f a -> hexists (fun a' => a' < a /\ f a' = b)
  }.
Arguments simulation_is_hom {_ _ _ _} _ {_ _ _}.

Instance ishprop_IsSimulation `{Funext}
         {A B : Ordinal} (f : A -> B) :
  IsHProp (IsSimulation f).
H: Funext
A, B: Ordinal
f: A -> B
IsHProp (IsSimulation f)
Proof.
H: Funext
A, B: Ordinal
f: A -> B
IsHProp (IsSimulation f)
  eapply istrunc_equiv_istrunc.
H: Funext
A, B: Ordinal
f: A -> B
?A <~> IsSimulation f
H: Funext
A, B: Ordinal
f: A -> B
IsHProp ?A
  -
H: Funext
A, B: Ordinal
f: A -> B
?A <~> IsSimulation f issig.
  -
H: Funext
A, B: Ordinal
f: A -> B
IsHProp
  {_ : forall a a' : A, a < a' -> f a < f a' &
  forall (a : A) (b : B),
  b < f a ->
  hexists (fun a' : A => ((a' < a) * (f a' = b))%type)} exact _.
Qed.

Instance isinjective_simulation
         {A : Type} {R : Lt A} `{IsOrdinal A R}
         {B : Type} {Q : Lt B} `{IsOrdinal B Q}
         (f : A -> B) {is_simulation : IsSimulation f}
  : IsInjective f.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
IsInjective f
Proof.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
IsInjective f
  intros a.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
forall y : A, f a = f y -> a = y induction (well_foundedness a) as [a _ IHa].
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
forall y : A, f a = f y -> a = y
  intros b.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
b: A
f a = f b -> a = b
  revert a IHa.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b -> a = b induction (well_foundedness b) as [b _ IHb].
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b -> a = b intros a IHa.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
f a = f b -> a = b
  intros fa_fb.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
a = b apply extensionality; intros c.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c < a <-> c < b split.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c < a -> c < b
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c < b -> c < a
  -
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c < a -> c < b intros c_a.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_a: c < a
c < b
    assert (fc_fa : f c < f a)
      by exact (simulation_is_hom f c_a).
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_a: c < a
fc_fa: f c < f a
c < b
    assert (fc_fb : f c < f b)
      by (rewrite <- fa_fb; exact fc_fa).
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_a: c < a
fc_fa: f c < f a
fc_fb: f c < f b
c < b
    assert (H1 : hexists (fun c' => c' < b /\ f c' = f c))
      by exact (simulation_is_merely_minimal fc_fb).
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_a: c < a
fc_fa: f c < f a
fc_fb: f c < f b
H1: hexists
  (fun c' : A => ((c' < b) * (f c' = f c))%type)
c < b
    refine (Trunc_rec _ H1).
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_a: c < a
fc_fa: f c < f a
fc_fb: f c < f b
H1: hexists
  (fun c' : A => ((c' < b) * (f c' = f c))%type)
{c' : A & ((c' < b) * (f c' = f c))%type} -> c < b intros (c' & c'_b & fc'_fc).
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_a: c < a
fc_fa: f c < f a
fc_fb: f c < f b
H1: hexists
  (fun c' : A => ((c' < b) * (f c' = f c))%type)
c': A
c'_b: c' < b
fc'_fc: f c' = f c
c < b
    assert (c = c') as ->.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_a: c < a
fc_fa: f c < f a
fc_fb: f c < f b
H1: hexists
  (fun c' : A => ((c' < b) * (f c' = f c))%type)
c': A
c'_b: c' < b
fc'_fc: f c' = f c
c = c'
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c': A
H1: hexists
  (fun c'0 : A =>
   ((c'0 < b) * (f c'0 = f c'))%type)
fc_fb: f c' < f b
fc_fa: f c' < f a
c_a: c' < a
c'_b: c' < b
fc'_fc: f c' = f c'
c' < b {
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_a: c < a
fc_fa: f c < f a
fc_fb: f c < f b
H1: hexists
  (fun c' : A => ((c' < b) * (f c' = f c))%type)
c': A
c'_b: c' < b
fc'_fc: f c' = f c
c = c'
      apply IHa.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_a: c < a
fc_fa: f c < f a
fc_fb: f c < f b
H1: hexists
  (fun c' : A => ((c' < b) * (f c' = f c))%type)
c': A
c'_b: c' < b
fc'_fc: f c' = f c
c < a
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_a: c < a
fc_fa: f c < f a
fc_fb: f c < f b
H1: hexists
  (fun c' : A => ((c' < b) * (f c' = f c))%type)
c': A
c'_b: c' < b
fc'_fc: f c' = f c
f c = f c'
      +
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_a: c < a
fc_fa: f c < f a
fc_fb: f c < f b
H1: hexists
  (fun c' : A => ((c' < b) * (f c' = f c))%type)
c': A
c'_b: c' < b
fc'_fc: f c' = f c
c < a exact c_a.
      +
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_a: c < a
fc_fa: f c < f a
fc_fb: f c < f b
H1: hexists
  (fun c' : A => ((c' < b) * (f c' = f c))%type)
c': A
c'_b: c' < b
fc'_fc: f c' = f c
f c = f c' symmetry.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_a: c < a
fc_fa: f c < f a
fc_fb: f c < f b
H1: hexists
  (fun c' : A => ((c' < b) * (f c' = f c))%type)
c': A
c'_b: c' < b
fc'_fc: f c' = f c
f c' = f c exact fc'_fc.
    }
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c': A
H1: hexists
  (fun c'0 : A =>
   ((c'0 < b) * (f c'0 = f c'))%type)
fc_fb: f c' < f b
fc_fa: f c' < f a
c_a: c' < a
c'_b: c' < b
fc'_fc: f c' = f c'
c' < b
    exact c'_b.
  -
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c < b -> c < a intros c_b.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_b: c < b
c < a
    assert (fc_fb : f c < f b)
      by exact (simulation_is_hom f c_b).
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_b: c < b
fc_fb: f c < f b
c < a
    assert (fc_fa : f c < f a)
      by (rewrite fa_fb; exact fc_fb).
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_b: c < b
fc_fb: f c < f b
fc_fa: f c < f a
c < a
    assert (H1 : hexists (fun c' => c' < a /\ f c' = f c))
      by exact (simulation_is_merely_minimal fc_fa).
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_b: c < b
fc_fb: f c < f b
fc_fa: f c < f a
H1: hexists
  (fun c' : A => ((c' < a) * (f c' = f c))%type)
c < a
    refine (Trunc_rec _ H1).
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_b: c < b
fc_fb: f c < f b
fc_fa: f c < f a
H1: hexists
  (fun c' : A => ((c' < a) * (f c' = f c))%type)
{c' : A & ((c' < a) * (f c' = f c))%type} -> c < a intros (c' & c'_a & fc'_fc).
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_b: c < b
fc_fb: f c < f b
fc_fa: f c < f a
H1: hexists
  (fun c' : A => ((c' < a) * (f c' = f c))%type)
c': A
c'_a: c' < a
fc'_fc: f c' = f c
c < a
    assert (c' = c) as <-.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_b: c < b
fc_fb: f c < f b
fc_fa: f c < f a
H1: hexists
  (fun c' : A => ((c' < a) * (f c' = f c))%type)
c': A
c'_a: c' < a
fc'_fc: f c' = f c
c' = c
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c': A
H1: hexists
  (fun c'0 : A =>
   ((c'0 < a) * (f c'0 = f c'))%type)
fc_fa: f c' < f a
fc_fb: f c' < f b
c_b: c' < b
c'_a: c' < a
fc'_fc: f c' = f c'
c' < a
    +
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_b: c < b
fc_fb: f c < f b
fc_fa: f c < f a
H1: hexists
  (fun c' : A => ((c' < a) * (f c' = f c))%type)
c': A
c'_a: c' < a
fc'_fc: f c' = f c
c' = c apply IHb.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_b: c < b
fc_fb: f c < f b
fc_fa: f c < f a
H1: hexists
  (fun c' : A => ((c' < a) * (f c' = f c))%type)
c': A
c'_a: c' < a
fc'_fc: f c' = f c
c < b
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_b: c < b
fc_fb: f c < f b
fc_fa: f c < f a
H1: hexists
  (fun c' : A => ((c' < a) * (f c' = f c))%type)
c': A
c'_a: c' < a
fc'_fc: f c' = f c
forall b : A,
b < c' -> forall y : A, f b = f y -> b = y
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_b: c < b
fc_fb: f c < f b
fc_fa: f c < f a
H1: hexists
  (fun c' : A => ((c' < a) * (f c' = f c))%type)
c': A
c'_a: c' < a
fc'_fc: f c' = f c
f c' = f c
      *
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_b: c < b
fc_fb: f c < f b
fc_fa: f c < f a
H1: hexists
  (fun c' : A => ((c' < a) * (f c' = f c))%type)
c': A
c'_a: c' < a
fc'_fc: f c' = f c
c < b exact c_b.
      *
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_b: c < b
fc_fb: f c < f b
fc_fa: f c < f a
H1: hexists
  (fun c' : A => ((c' < a) * (f c' = f c))%type)
c': A
c'_a: c' < a
fc'_fc: f c' = f c
forall b : A,
b < c' -> forall y : A, f b = f y -> b = y intros a' a'_c'.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_b: c < b
fc_fb: f c < f b
fc_fa: f c < f a
H1: hexists
  (fun c' : A => ((c' < a) * (f c' = f c))%type)
c': A
c'_a: c' < a
fc'_fc: f c' = f c
a': A
a'_c': a' < c'
forall y : A, f a' = f y -> a' = y apply IHa.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_b: c < b
fc_fb: f c < f b
fc_fa: f c < f a
H1: hexists
  (fun c' : A => ((c' < a) * (f c' = f c))%type)
c': A
c'_a: c' < a
fc'_fc: f c' = f c
a': A
a'_c': a' < c'
a' < a exact (transitivity a'_c' c'_a).
      *
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c: A
c_b: c < b
fc_fb: f c < f b
fc_fa: f c < f a
H1: hexists
  (fun c' : A => ((c' < a) * (f c' = f c))%type)
c': A
c'_a: c' < a
fc'_fc: f c' = f c
f c' = f c exact fc'_fc.
    +
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
b: A
IHb: forall b0 : A,
b0 < b ->
forall a : A,
(forall b : A,
 b < a -> forall y : A, f b = f y -> b = y) ->
f a = f b0 -> a = b0
a: A
IHa: forall b : A,
b < a -> forall y : A, f b = f y -> b = y
fa_fb: f a = f b
c': A
H1: hexists
  (fun c'0 : A =>
   ((c'0 < a) * (f c'0 = f c'))%type)
fc_fa: f c' < f a
fc_fb: f c' < f b
c_b: c' < b
c'_a: c' < a
fc'_fc: f c' = f c'
c' < a exact c'_a.
Qed.


Lemma simulation_is_minimal
      {A : Type} {R : Lt A} `{IsOrdinal A R}
      {B : Type} {Q : Lt B} `{IsOrdinal B Q}
      (f : A -> B) {is_simulation : IsSimulation f}
  : forall {a b}, b < f a -> exists a', a' < a /\ f a' = b.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
forall (a : A) (b : B),
b < f a -> {a' : A & ((a' < a) * (f a' = b))%type}
Proof.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
forall (a : A) (b : B),
b < f a -> {a' : A & ((a' < a) * (f a' = b))%type}
  intros a b H1.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
b: B
H1: b < f a
{a' : A & ((a' < a) * (f a' = b))%type}
  refine (Trunc_rec _ (simulation_is_merely_minimal H1)).
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
b: B
H1: b < f a
IsHProp {a' : A & ((a' < a) * (f a' = b))%type}
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
b: B
H1: b < f a
{a' : A & ((a' < a) * (f a' = b))%type} ->
{a' : A & ((a' < a) * (f a' = b))%type} {
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
b: B
H1: b < f a
IsHProp {a' : A & ((a' < a) * (f a' = b))%type}
    apply hprop_allpath.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
b: B
H1: b < f a
forall x y : {a' : A & ((a' < a) * (f a' = b))%type},
x = y intros (a1 & ? & p) (a2 & ? & <-).
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a, a2: A
H1: f a2 < f a
a1: A
fst: a1 < a
p: f a1 = f a2
fst0: a2 < a
(a1; (fst, p)) = (a2; (fst0, 1%path))
    apply path_sigma_hprop; cbn.
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a, a2: A
H1: f a2 < f a
a1: A
fst: a1 < a
p: f a1 = f a2
fst0: a2 < a
a1 = a2 apply (injective f).
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a, a2: A
H1: f a2 < f a
a1: A
fst: a1 < a
p: f a1 = f a2
fst0: a2 < a
f a1 = f a2 exact p.
  }
A: Type
R: Lt A
H: IsOrdinal A R
B: Type
Q: Lt B
H0: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
b: B
H1: b < f a
{a' : A & ((a' < a) * (f a' = b))%type} ->
{a' : A & ((a' < a) * (f a' = b))%type}
  exact idmap.
Qed.


Lemma path_simulation `{Funext}
      {A B : Ordinal}
      (f : A -> B) {is_simulation_f : IsSimulation f}
      (g : A -> B) {is_simulation_g : IsSimulation g}
  : f = g.
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
f = g
Proof.
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
f = g
  apply path_forall; intros a.
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
a: A
f a = g a
  induction (well_foundedness a) as [a _ IH].
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
a: A
IH: forall b : A, b < a -> f b = g b
f a = g a
  apply (extensionality (f a) (g a)).
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
a: A
IH: forall b : A, b < a -> f b = g b
forall c : B, c < f a <-> c < g a
  intros b.
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
a: A
IH: forall b : A, b < a -> f b = g b
b: B
b < f a <-> b < g a
  split.
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
a: A
IH: forall b : A, b < a -> f b = g b
b: B
b < f a -> b < g a
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
a: A
IH: forall b : A, b < a -> f b = g b
b: B
b < g a -> b < f a
  -
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
a: A
IH: forall b : A, b < a -> f b = g b
b: B
b < f a -> b < g a intros b_fa.
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
a: A
IH: forall b : A, b < a -> f b = g b
b: B
b_fa: b < f a
b < g a
    destruct (simulation_is_minimal f b_fa) as (a' & a'_a & <-).
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
a: A
IH: forall b : A, b < a -> f b = g b
a': A
b_fa: f a' < f a
a'_a: a' < a
f a' < g a
    rewrite (IH _ a'_a).
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
a: A
IH: forall b : A, b < a -> f b = g b
a': A
b_fa: f a' < f a
a'_a: a' < a
g a' < g a apply (simulation_is_hom g).
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
a: A
IH: forall b : A, b < a -> f b = g b
a': A
b_fa: f a' < f a
a'_a: a' < a
a' < a exact a'_a.
  -
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
a: A
IH: forall b : A, b < a -> f b = g b
b: B
b < g a -> b < f a intros b_ga.
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
a: A
IH: forall b : A, b < a -> f b = g b
b: B
b_ga: b < g a
b < f a
    destruct (simulation_is_minimal g b_ga) as (a' & a'_a & <-).
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
a: A
IH: forall b : A, b < a -> f b = g b
a': A
b_ga: g a' < g a
a'_a: a' < a
g a' < f a
    rewrite <- (IH _ a'_a).
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
a: A
IH: forall b : A, b < a -> f b = g b
a': A
b_ga: g a' < g a
a'_a: a' < a
f a' < f a apply (simulation_is_hom f).
H: Funext
A, B: Ordinal
f: A -> B
is_simulation_f: IsSimulation f
g: A -> B
is_simulation_g: IsSimulation g
a: A
IH: forall b : A, b < a -> f b = g b
a': A
b_ga: g a' < g a
a'_a: a' < a
a' < a exact a'_a.
Qed.


Instance is_simulation_isomorphism
         {A : Type} {R__A : Lt A}
         {B : Type} {R__B : Lt B}
         (f : Isomorphism (A; R__A) (B; R__B))
  : IsSimulation f.1.
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
IsSimulation f.1
Proof.
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
IsSimulation f.1
  constructor.
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
forall a a' : A, a < a' -> f.1 a < f.1 a'
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
forall (a : A) (b : B),
b < f.1 a ->
hexists (fun a' : A => ((a' < a) * (f.1 a' = b))%type)
  -
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
forall a a' : A, a < a' -> f.1 a < f.1 a' intros a a' a_a'.
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
a, a': A
a_a': a < a'
f.1 a < f.1 a' apply f.2.
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
a, a': A
a_a': a < a'
R__A a a' exact a_a'.
  -
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
forall (a : A) (b : B),
b < f.1 a ->
hexists (fun a' : A => ((a' < a) * (f.1 a' = b))%type) intros a b b_fa.
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
a: A
b: B
b_fa: b < f.1 a
hexists (fun a' : A => ((a' < a) * (f.1 a' = b))%type) apply tr.
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
a: A
b: B
b_fa: b < f.1 a
{a' : A & ((a' < a) * (f.1 a' = b))%type} exists (f.1^-1 b).
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
a: A
b: B
b_fa: b < f.1 a
(((f.1)^-1 b < a) * (f.1 ((f.1)^-1 b) = b))%type split.
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
a: A
b: B
b_fa: b < f.1 a
(f.1)^-1 b < a
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
a: A
b: B
b_fa: b < f.1 a
f.1 ((f.1)^-1 b) = b
    +
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
a: A
b: B
b_fa: b < f.1 a
(f.1)^-1 b < a apply f.2.
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
a: A
b: B
b_fa: b < f.1 a
R__B (f.1 ((f.1)^-1 b)) (f.1 a) rewrite eisretr.
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
a: A
b: B
b_fa: b < f.1 a
R__B b (f.1 a) exact b_fa.
    +
A: Type
R__A: Lt A
B: Type
R__B: Lt B
f: Isomorphism (A; R__A) (B; R__B)
a: A
b: B
b_fa: b < f.1 a
f.1 ((f.1)^-1 b) = b apply eisretr.
Qed.


Instance ishprop_Isomorphism `{Funext} (A B : Ordinal)
  : IsHProp (Isomorphism A B).
H: Funext
A, B: Ordinal
IsHProp (Isomorphism A B)
Proof.
H: Funext
A, B: Ordinal
IsHProp (Isomorphism A B)
  apply hprop_allpath; intros f g.
H: Funext
A, B: Ordinal
f, g: Isomorphism A B
f = g apply path_sigma_hprop; cbn.
H: Funext
A, B: Ordinal
f, g: Isomorphism A B
f.1 = g.1
  apply path_equiv.
H: Funext
A, B: Ordinal
f, g: Isomorphism A B
f.1 = g.1 apply path_simulation; exact _.
Qed.


Instance ishset_Ordinal `{Univalence}
  : IsHSet Ordinal.
H: Univalence
IsHSet Ordinal
Proof.
H: Univalence
IsHSet Ordinal
  apply istrunc_S.
H: Univalence
is_mere_relation Ordinal paths
  intros A B.
H: Univalence
A, B: Ordinal
IsHProp (A = B)
  apply (istrunc_equiv_istrunc (Isomorphism A B)).
H: Univalence
A, B: Ordinal
Isomorphism A B <~> A = B
H: Univalence
A, B: Ordinal
IsHProp (Isomorphism A B) {
H: Univalence
A, B: Ordinal
Isomorphism A B <~> A = B
    apply equiv_path_Ordinal.
  }
H: Univalence
A, B: Ordinal
IsHProp (Isomorphism A B)
  exact _.
Qed.



Lemma isordinal_simulation
      {A : Type}
     `{IsHSet A}

      {R : Lt A}
      {mere : is_mere_relation _ R}

      {B : Type}
      {Q : Lt B}
     `{IsOrdinal B Q}

      (f : A -> B)
     `{IsInjective _ _ f}
      {is_simulation : IsSimulation f}

  : IsOrdinal A R.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
IsOrdinal A R
Proof.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
IsOrdinal A R
  constructor.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
IsHSet A
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
is_mere_relation A R
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
Extensional R
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
WellFounded R
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
Transitive R
  -
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
IsHSet A exact _.
  -
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
is_mere_relation A R exact _.
  -
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
Extensional R intros a a' H1.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
a = a' apply (injective f).
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
f a = f a' apply extensionality.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
forall c : B, c < f a <-> c < f a'
    intros b.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
b: B
b < f a <-> b < f a' split.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
b: B
b < f a -> b < f a'
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
b: B
b < f a' -> b < f a
    +
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
b: B
b < f a -> b < f a' intros b_fa.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
b: B
b_fa: b < f a
b < f a' refine (Trunc_rec _ (simulation_is_merely_minimal b_fa)).
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
b: B
b_fa: b < f a
{a' : A & ((a' < a) * (f a' = b))%type} -> b < f a'
      intros [a0 [a0_a <-]].
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
a0: A
b_fa: f a0 < f a
a0_a: a0 < a
f a0 < f a'
      apply (simulation_is_hom f).
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
a0: A
b_fa: f a0 < f a
a0_a: a0 < a
a0 < a' apply H1.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
a0: A
b_fa: f a0 < f a
a0_a: a0 < a
a0 < a exact a0_a.
    +
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
b: B
b < f a' -> b < f a intros b_fa'.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
b: B
b_fa': b < f a'
b < f a refine (Trunc_rec _ (simulation_is_merely_minimal b_fa')).
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
b: B
b_fa': b < f a'
{a'0 : A & ((a'0 < a') * (f a'0 = b))%type} -> b < f a
      intros [a0 [a0_a' <-]].
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
a0: A
b_fa': f a0 < f a'
a0_a': a0 < a'
f a0 < f a
      apply (simulation_is_hom f).
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
a0: A
b_fa': f a0 < f a'
a0_a': a0 < a'
a0 < a apply H1.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, a': A
H1: forall c : A, c < a <-> c < a'
a0: A
b_fa': f a0 < f a'
a0_a': a0 < a'
a0 < a' exact a0_a'.
  -
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
WellFounded R intros a.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a: A
Accessible R a remember (f a) as b eqn: fa_b.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a: A
b: B
fa_b: f a = b
Accessible R a
    revert a fa_b.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
b: B
forall a : A, f a = b -> Accessible R a induction (well_foundedness b) as [b _ IH].
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
b: B
IH: forall b0 : B,
b0 < b ->
forall a : A, f a = b0 -> Accessible R a
forall a : A, f a = b -> Accessible R a intros a <-.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a: A
IH: forall b : B,
b < f a ->
forall a : A, f a = b -> Accessible R a
Accessible R a
    constructor; intros a' a'_a.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a: A
IH: forall b : B,
b < f a ->
forall a : A, f a = b -> Accessible R a
a': A
a'_a: a' < a
Accessible R a' apply (IH (f a')).
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a: A
IH: forall b : B,
b < f a ->
forall a : A, f a = b -> Accessible R a
a': A
a'_a: a' < a
f a' < f a
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a: A
IH: forall b : B,
b < f a ->
forall a : A, f a = b -> Accessible R a
a': A
a'_a: a' < a
f a' = f a'
    +
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a: A
IH: forall b : B,
b < f a ->
forall a : A, f a = b -> Accessible R a
a': A
a'_a: a' < a
f a' < f a apply (simulation_is_hom f).
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a: A
IH: forall b : B,
b < f a ->
forall a : A, f a = b -> Accessible R a
a': A
a'_a: a' < a
a' < a exact a'_a.
    +
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a: A
IH: forall b : B,
b < f a ->
forall a : A, f a = b -> Accessible R a
a': A
a'_a: a' < a
f a' = f a' reflexivity.
  -
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
Transitive R intros a b c a_b b_c.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, b, c: A
a_b: R a b
b_c: R b c
R a c
    assert (fa_fc : f a < f c).
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, b, c: A
a_b: R a b
b_c: R b c
f a < f c
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, b, c: A
a_b: R a b
b_c: R b c
fa_fc: f a < f c
R a c {
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, b, c: A
a_b: R a b
b_c: R b c
f a < f c
      transitivity (f b).
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, b, c: A
a_b: R a b
b_c: R b c
f a < f b
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, b, c: A
a_b: R a b
b_c: R b c
f b < f c {
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, b, c: A
a_b: R a b
b_c: R b c
f a < f b
        apply (simulation_is_hom f).
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, b, c: A
a_b: R a b
b_c: R b c
a < b exact a_b.
      }
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, b, c: A
a_b: R a b
b_c: R b c
f b < f c
      apply (simulation_is_hom f).
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, b, c: A
a_b: R a b
b_c: R b c
b < c exact b_c.
    }
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, b, c: A
a_b: R a b
b_c: R b c
fa_fc: f a < f c
R a c
    refine (Trunc_rec _ (simulation_is_merely_minimal fa_fc)).
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, b, c: A
a_b: R a b
b_c: R b c
fa_fc: f a < f c
{a' : A & ((a' < c) * (f a' = f a))%type} -> R a c
    intros [a' [a'_c fa'_fa]].
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, b, c: A
a_b: R a b
b_c: R b c
fa_fc: f a < f c
a': A
a'_c: a' < c
fa'_fa: f a' = f a
R a c apply (injective f) in fa'_fa.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, b, c: A
a_b: R a b
b_c: R b c
fa_fc: f a < f c
a': A
a'_c: a' < c
fa'_fa: a' = a
R a c subst a'.
A: Type
IsHSet0: IsHSet A
R: Lt A
mere: is_mere_relation A R
B: Type
Q: Lt B
H: IsOrdinal B Q
f: A -> B
H0: IsInjective f
is_simulation: IsSimulation f
a, b, c: A
a_b: R a b
b_c: R b c
fa_fc: f a < f c
a'_c: a < c
R a c
    exact a'_c.
Qed.





(** * Initial segments *)

Definition initial_segment `{PropResizing}
           {A : Type} {R : Lt A} `{IsOrdinal A R} (a : A)
  : Ordinal.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
Ordinal
Proof.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
Ordinal
  srefine {| ordinal_carrier := {b : A & smalltype (b < a)}
           ; ordinal_relation := fun x y => x.1 < y.1
           |};
    try exact _.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
IsOrdinal {b : A & smalltype (b < a)} lt
  srapply (isordinal_simulation pr1).
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
is_mere_relation {b : A & smalltype (b < a)} lt
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
Lt A
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
IsOrdinal A ?Q
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
IsSimulation pr1
  -
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
is_mere_relation {b : A & smalltype (b < a)} lt unfold lt.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
forall x y : {b : A & smalltype (R b a)},
IsHProp (R x.1 y.1) exact _.
  -
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
Lt A exact _.
  -
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
IsOrdinal A R exact _.
  -
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
IsSimulation pr1 constructor.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
forall a0 a' : {b : A & smalltype (b < a)},
a0 < a' -> a0.1 < a'.1
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
forall (a0 : {b : A & smalltype (b < a)}) (b : A),
b < a0.1 ->
hexists
  (fun a' : {b0 : A & smalltype (b0 < a)} =>
   ((a' < a0) * (a'.1 = b))%type)
    +
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
forall a0 a' : {b : A & smalltype (b < a)},
a0 < a' -> a0.1 < a'.1 intros x y x_y.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
x, y: {b : A & smalltype (b < a)}
x_y: x < y
x.1 < y.1 exact x_y.
    +
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
forall (a0 : {b : A & smalltype (b < a)}) (b : A),
b < a0.1 ->
hexists
  (fun a' : {b0 : A & smalltype (b0 < a)} =>
   ((a' < a0) * (a'.1 = b))%type) intros b a' a'_b; cbn in *.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
Trunc (-1)
  {a'0 : {b : A & smalltype (b < a)} &
  ((a'0 < b) * (a'0.1 = a'))%type} apply tr.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
{a'0 : {b : A & smalltype (b < a)} &
((a'0 < b) * (a'0.1 = a'))%type}
      assert (b_a : b.1 < a).
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
b.1 < a
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
b_a: b.1 < a
{a'0 : {b : A & smalltype (b < a)} &
((a'0 < b) * (a'0.1 = a'))%type} {
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
b.1 < a
        exact ((equiv_smalltype _) b.2).
      }
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
b_a: b.1 < a
{a'0 : {b : A & smalltype (b < a)} &
((a'0 < b) * (a'0.1 = a'))%type}
      srapply exist.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
b_a: b.1 < a
{b : A & smalltype (b < a)}
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
b_a: b.1 < a
(fun a'0 : {b : A & smalltype (b < a)} =>
 ((a'0 < b) * (a'0.1 = a'))%type) 
  ?proj1 {
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
b_a: b.1 < a
{b : A & smalltype (b < a)}
        exists a'.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
b_a: b.1 < a
smalltype (a' < a)
        apply equiv_smalltype.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
b_a: b.1 < a
a' < a exact (transitivity a'_b b_a).
      }
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
b_a: b.1 < a
(fun a'0 : {b : A & smalltype (b < a)} =>
 ((a'0 < b) * (a'0.1 = a'))%type)
  (a';
  let X :=
    fun (X : Type) (IsSmall : IsSmall X) =>
    equiv_isequiv (equiv_smalltype X) in
  let X0 :=
    fun (X0 : Type) (IsSmall : IsSmall X0) =>
    (equiv_smalltype X0)^-1 in
  X0 (a' < a)
    (issmall_hprop (a' < a)
       (ordinal_relation_is_mere a' a))
    (transitivity a'_b b_a))
      cbn.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
b_a: b.1 < a
(((a';
  (equiv_smalltype (a' < a))^-1
    (ordinal_transitivity a' b.1 a a'_b b_a)) < b) *
 (a' = a'))%type split.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
b_a: b.1 < a
(a';
(equiv_smalltype (a' < a))^-1
  (ordinal_transitivity a' b.1 a a'_b b_a)) < b
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
b_a: b.1 < a
a' = a'
      *
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
b_a: b.1 < a
(a';
(equiv_smalltype (a' < a))^-1
  (ordinal_transitivity a' b.1 a a'_b b_a)) < b exact a'_b.
      *
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
a: A
b: {b : A & smalltype (b < a)}
a': A
a'_b: a' < b.1
b_a: b.1 < a
a' = a' reflexivity.
Defined.

Declare Scope Ordinals.
Open Scope Ordinals.

Notation "↓ a" := (initial_segment a) (at level 4, format "↓ a") : Ordinals.
(* 3 is the level of most unary postfix operators in the standard lib, e.g. f^-1 *)

Definition in_
          `{PropResizing}
           {A : Ordinal} {a : A}
           (x : A) (H : x < a)
  : ↓a
  := (x; (equiv_smalltype _)^-1 H).

Definition out
           `{PropResizing}
           {A : Ordinal} {a : A}
  : ↓a -> A
  := pr1.

Definition initial_segment_property `{PropResizing}
  {A : Ordinal} {a : A}
  : forall x : ↓a, out x < a.
H: PropResizing
A: Ordinal
a: A
forall x : ↓a, out x < a
Proof.
H: PropResizing
A: Ordinal
a: A
forall x : ↓a, out x < a
  intros x.
H: PropResizing
A: Ordinal
a: A
x: ↓a
out x < a exact (equiv_smalltype _ (proj2 x)).
Defined.


Instance is_simulation_out `{PropResizing}
  {A : Ordinal} (a : A)
  : IsSimulation (out : ↓a -> A).
H: PropResizing
A: Ordinal
a: A
IsSimulation (out : ↓a -> A)
Proof.
H: PropResizing
A: Ordinal
a: A
IsSimulation (out : ↓a -> A)
  unfold out.
H: PropResizing
A: Ordinal
a: A
IsSimulation pr1
  constructor.
H: PropResizing
A: Ordinal
a: A
forall a0 a' : ↓a, a0 < a' -> a0.1 < a'.1
H: PropResizing
A: Ordinal
a: A
forall (a0 : ↓a) (b : A),
b < a0.1 ->
hexists (fun a' : ↓a => ((a' < a0) * (a'.1 = b))%type)
  -
H: PropResizing
A: Ordinal
a: A
forall a0 a' : ↓a, a0 < a' -> a0.1 < a'.1 auto.
  -
H: PropResizing
A: Ordinal
a: A
forall (a0 : ↓a) (b : A),
b < a0.1 ->
hexists (fun a' : ↓a => ((a' < a0) * (a'.1 = b))%type) intros x a' a'_x.
H: PropResizing
A: Ordinal
a: A
x: ↓a
a': A
a'_x: a' < x.1
hexists
  (fun a'0 : ↓a => ((a'0 < x) * (a'0.1 = a'))%type) apply tr.
H: PropResizing
A: Ordinal
a: A
x: ↓a
a': A
a'_x: a' < x.1
{a'0 : ↓a & ((a'0 < x) * (a'0.1 = a'))%type}
    assert (a'_a : a' < a).
H: PropResizing
A: Ordinal
a: A
x: ↓a
a': A
a'_x: a' < x.1
a' < a
H: PropResizing
A: Ordinal
a: A
x: ↓a
a': A
a'_x: a' < x.1
a'_a: a' < a
{a'0 : ↓a & ((a'0 < x) * (a'0.1 = a'))%type} {
H: PropResizing
A: Ordinal
a: A
x: ↓a
a': A
a'_x: a' < x.1
a' < a
      transitivity (out x).
H: PropResizing
A: Ordinal
a: A
x: ↓a
a': A
a'_x: a' < x.1
a' < out x
H: PropResizing
A: Ordinal
a: A
x: ↓a
a': A
a'_x: a' < x.1
out x < a {
H: PropResizing
A: Ordinal
a: A
x: ↓a
a': A
a'_x: a' < x.1
a' < out x
        assumption.
      }
H: PropResizing
A: Ordinal
a: A
x: ↓a
a': A
a'_x: a' < x.1
out x < a
      apply initial_segment_property.  (* TODO: Rename? *)
    }
H: PropResizing
A: Ordinal
a: A
x: ↓a
a': A
a'_x: a' < x.1
a'_a: a' < a
{a'0 : ↓a & ((a'0 < x) * (a'0.1 = a'))%type}
    exists (in_ a' a'_a); cbn.
H: PropResizing
A: Ordinal
a: A
x: ↓a
a': A
a'_x: a' < x.1
a'_a: a' < a
((a' < x.1) * (a' = a'))%type auto.
Qed.


Instance isinjective_initial_segment `{Funext} `{PropResizing}
  (A : Ordinal)
  : IsInjective (initial_segment : A -> Ordinal).
H: Funext
H0: PropResizing
A: Ordinal
IsInjective (initial_segment : A -> Ordinal)
Proof.
H: Funext
H0: PropResizing
A: Ordinal
IsInjective (initial_segment : A -> Ordinal)
  enough (H1 : forall a1 a2 : A, ↓a1 = ↓a2 -> forall b : ↓a1, out b < a2).
H: Funext
H0: PropResizing
A: Ordinal
H1: forall a1 a2 : A,
↓a1 = ↓a2 -> forall b : ↓a1, out b < a2
IsInjective (initial_segment : A -> Ordinal)
H: Funext
H0: PropResizing
A: Ordinal
forall a1 a2 : A,
↓a1 = ↓a2 -> forall b : ↓a1, out b < a2 {
H: Funext
H0: PropResizing
A: Ordinal
H1: forall a1 a2 : A,
↓a1 = ↓a2 -> forall b : ↓a1, out b < a2
IsInjective (initial_segment : A -> Ordinal)
    intros a1 a2 p.
H: Funext
H0: PropResizing
A: Ordinal
H1: forall a1 a2 : A,
↓a1 = ↓a2 -> forall b : ↓a1, out b < a2
a1, a2: A
p: ↓a1 = ↓a2
a1 = a2 apply extensionality; intros b.
H: Funext
H0: PropResizing
A: Ordinal
H1: forall a1 a2 : A,
↓a1 = ↓a2 -> forall b : ↓a1, out b < a2
a1, a2: A
p: ↓a1 = ↓a2
b: A
b < a1 <-> b < a2 split.
H: Funext
H0: PropResizing
A: Ordinal
H1: forall a1 a2 : A,
↓a1 = ↓a2 -> forall b : ↓a1, out b < a2
a1, a2: A
p: ↓a1 = ↓a2
b: A
b < a1 -> b < a2
H: Funext
H0: PropResizing
A: Ordinal
H1: forall a1 a2 : A,
↓a1 = ↓a2 -> forall b : ↓a1, out b < a2
a1, a2: A
p: ↓a1 = ↓a2
b: A
b < a2 -> b < a1
    -
H: Funext
H0: PropResizing
A: Ordinal
H1: forall a1 a2 : A,
↓a1 = ↓a2 -> forall b : ↓a1, out b < a2
a1, a2: A
p: ↓a1 = ↓a2
b: A
b < a1 -> b < a2 intros b_a1.
H: Funext
H0: PropResizing
A: Ordinal
H1: forall a1 a2 : A,
↓a1 = ↓a2 -> forall b : ↓a1, out b < a2
a1, a2: A
p: ↓a1 = ↓a2
b: A
b_a1: b < a1
b < a2 exact (H1 a1 a2 p (in_ b b_a1)).
    -
H: Funext
H0: PropResizing
A: Ordinal
H1: forall a1 a2 : A,
↓a1 = ↓a2 -> forall b : ↓a1, out b < a2
a1, a2: A
p: ↓a1 = ↓a2
b: A
b < a2 -> b < a1 intros b_a2.
H: Funext
H0: PropResizing
A: Ordinal
H1: forall a1 a2 : A,
↓a1 = ↓a2 -> forall b : ↓a1, out b < a2
a1, a2: A
p: ↓a1 = ↓a2
b: A
b_a2: b < a2
b < a1 exact (H1 a2 a1 p^ (in_ b b_a2)).
  }
H: Funext
H0: PropResizing
A: Ordinal
forall a1 a2 : A,
↓a1 = ↓a2 -> forall b : ↓a1, out b < a2

  intros a1 a2 p b.
H: Funext
H0: PropResizing
A: Ordinal
a1, a2: A
p: ↓a1 = ↓a2
b: ↓a1
out b < a2
  assert (out = transport (fun B : Ordinal => B -> A) p^ out)
    as ->.
H: Funext
H0: PropResizing
A: Ordinal
a1, a2: A
p: ↓a1 = ↓a2
b: ↓a1
out = transport (fun B : Ordinal => B -> A) p^ out
H: Funext
H0: PropResizing
A: Ordinal
a1, a2: A
p: ↓a1 = ↓a2
b: ↓a1
transport (fun B : Ordinal => B -> A) p^ out b < a2 {
H: Funext
H0: PropResizing
A: Ordinal
a1, a2: A
p: ↓a1 = ↓a2
b: ↓a1
out = transport (fun B : Ordinal => B -> A) p^ out
    apply path_simulation.
H: Funext
H0: PropResizing
A: Ordinal
a1, a2: A
p: ↓a1 = ↓a2
b: ↓a1
IsSimulation out
H: Funext
H0: PropResizing
A: Ordinal
a1, a2: A
p: ↓a1 = ↓a2
b: ↓a1
IsSimulation
  (transport (fun B : Ordinal => B -> A) p^ out)
    -
H: Funext
H0: PropResizing
A: Ordinal
a1, a2: A
p: ↓a1 = ↓a2
b: ↓a1
IsSimulation out exact _.
    -
H: Funext
H0: PropResizing
A: Ordinal
a1, a2: A
p: ↓a1 = ↓a2
b: ↓a1
IsSimulation
  (transport (fun B : Ordinal => B -> A) p^ out) apply transportD.
H: Funext
H0: PropResizing
A: Ordinal
a1, a2: A
p: ↓a1 = ↓a2
b: ↓a1
IsSimulation out exact _.
  }
H: Funext
H0: PropResizing
A: Ordinal
a1, a2: A
p: ↓a1 = ↓a2
b: ↓a1
transport (fun B : Ordinal => B -> A) p^ out b < a2
  rewrite transport_arrow_toconst.
H: Funext
H0: PropResizing
A: Ordinal
a1, a2: A
p: ↓a1 = ↓a2
b: ↓a1
out (transport (fun x : Ordinal => x) (p^)^ b) < a2 rewrite inv_V.
H: Funext
H0: PropResizing
A: Ordinal
a1, a2: A
p: ↓a1 = ↓a2
b: ↓a1
out (transport (fun x : Ordinal => x) p b) < a2 apply initial_segment_property.
Qed.

Lemma equiv_initial_segment_simulation
      `{PropResizing}
      {A : Type@{A}} {R : Lt@{_ R} A} `{IsOrdinal A R}
      {B : Type@{B}} {Q : Lt@{_ Q} B} `{IsOrdinal B Q}
      (f : A -> B) {is_simulation : IsSimulation f} (a : A)
  : Isomorphism ↓(f a) ↓a.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
Isomorphism ↓(f a) ↓a
Proof.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
Isomorphism ↓(f a) ↓a
  apply isomorphism_inverse.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
Isomorphism ↓a ↓(f a)
  srapply exist.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
(↓a).1 <~> (↓(f a)).1
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
(fun f0 : (↓a).1 <~> (↓(f a)).1 =>
 forall a0 a' : (↓a).1,
 (↓a).2 a0 a' <-> (↓(f a)).2 (f0 a0) (f0 a')) 
  ?proj1
  -
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
(↓a).1 <~> (↓(f a)).1 srapply equiv_adjointify.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
↓a -> ↓(f a)
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
↓(f a) -> ↓a
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
?f o ?g == idmap
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
?g o ?f == idmap
    +
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
↓a -> ↓(f a) intros x.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: ↓a
↓(f a) exists (f x.1).
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: ↓a
smalltype (f x.1 < f a) apply (equiv_smalltype _)^-1.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: ↓a
f x.1 < f a
      rapply simulation_is_hom.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: ↓a
x.1 < a apply (equiv_smalltype _).
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: ↓a
smalltype (x.1 < a) exact x.2.
    +
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
↓(f a) -> ↓a intros x.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: ↓(f a)
↓a
      assert (x_fa : x.1 < f a).
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: ↓(f a)
x.1 < f a
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: ↓(f a)
x_fa: x.1 < f a
↓a {
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: ↓(f a)
x.1 < f a
        exact ((equiv_smalltype _) x.2).
      }
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: ↓(f a)
x_fa: x.1 < f a
↓a
      destruct (simulation_is_minimal f x_fa) as (a' & a'_a & _).
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: ↓(f a)
x_fa: x.1 < f a
a': A
a'_a: a' < a
↓a
      exact (a'; (equiv_smalltype _)^-1 a'_a).
    +
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
(fun x : ↓a =>
 (f x.1;
 (equiv_smalltype (f x.1 < f a))^-1
   (simulation_is_hom f
      (let X := equiv_fun (equiv_smalltype (x.1 < a))
         in
       X x.2))))
o (fun x : ↓(f a) =>
   let x_fa := equiv_smalltype (x.1 < f a) x.2 in
   let s := simulation_is_minimal f x_fa in
   (fun (a' : A) (proj2 : (a' < a) * (f a' = x.1)) =>
    (fun (a'_a : a' < a) (_ : f a' = x.1) =>
     (a'; (equiv_smalltype (a' < a))^-1 a'_a))
      (fst proj2) (snd proj2)) s.1 s.2) == idmap cbn.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
(fun x : {b : B & smalltype (b < f a)} =>
 (f
    (simulation_is_minimal f
       (equiv_smalltype (x.1 < f a) x.2)).1;
 (equiv_smalltype
    (f
       (simulation_is_minimal f
          (equiv_smalltype (x.1 < f a) x.2)).1 < f a))^-1
   (simulation_is_hom f
      (equiv_smalltype
         ((simulation_is_minimal f
             (equiv_smalltype (x.1 < f a) x.2)).1 < a)
         ((equiv_smalltype
             ((simulation_is_minimal f
                 (equiv_smalltype (x.1 < f a) x.2)).1 <
              a))^-1
            (fst
               (simulation_is_minimal f
                  (equiv_smalltype (x.1 < f a) x.2)).2)))))) ==
idmap intros x.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : B & smalltype (b < f a)}
(f
   (simulation_is_minimal f
      (equiv_smalltype (x.1 < f a) x.2)).1;
(equiv_smalltype
   (f
      (simulation_is_minimal f
         (equiv_smalltype (x.1 < f a) x.2)).1 < f a))^-1
  (simulation_is_hom f
     (equiv_smalltype
        ((simulation_is_minimal f
            (equiv_smalltype (x.1 < f a) x.2)).1 < a)
        ((equiv_smalltype
            ((simulation_is_minimal f
                (equiv_smalltype (x.1 < f a) x.2)).1 <
             a))^-1
           (fst
              (simulation_is_minimal f
                 (equiv_smalltype (x.1 < f a) x.2)).2))))) =
x apply path_sigma_hprop; cbn.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : B & smalltype (b < f a)}
f
  (simulation_is_minimal f
     (equiv_smalltype (x.1 < f a) x.2)).1 = x.1
      transparent assert (x_fa : (x.1 < f a)).
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : B & smalltype (b < f a)}
x.1 < f a
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : B & smalltype (b < f a)}
x_fa:= ?Goal: x.1 < f a
f
  (simulation_is_minimal f
     (equiv_smalltype (x.1 < f a) x.2)).1 = x.1 {
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : B & smalltype (b < f a)}
x.1 < f a
        exact (equiv_smalltype _ x.2).
      }
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : B & smalltype (b < f a)}
x_fa:= equiv_smalltype (x.1 < f a) x.2: x.1 < f a
f
  (simulation_is_minimal f
     (equiv_smalltype (x.1 < f a) x.2)).1 = x.1
      exact (snd (simulation_is_minimal f x_fa).2).
    +
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
(fun x : ↓(f a) =>
 let x_fa := equiv_smalltype (x.1 < f a) x.2 in
 let s := simulation_is_minimal f x_fa in
 (fun (a' : A) (proj2 : (a' < a) * (f a' = x.1)) =>
  (fun (a'_a : a' < a) (_ : f a' = x.1) =>
   (a'; (equiv_smalltype (a' < a))^-1 a'_a))
    (fst proj2) (snd proj2)) s.1 s.2)
o (fun x : ↓a =>
   (f x.1;
   (equiv_smalltype (f x.1 < f a))^-1
     (simulation_is_hom f
        (let X :=
           equiv_fun (equiv_smalltype (x.1 < a)) in
         X x.2)))) == idmap cbn.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
(fun x : {b : A & smalltype (b < a)} =>
 ((simulation_is_minimal f
     (equiv_smalltype (f x.1 < f a)
        ((equiv_smalltype (f x.1 < f a))^-1
           (simulation_is_hom f
              (equiv_smalltype (x.1 < a) x.2))))).1;
 (equiv_smalltype
    ((simulation_is_minimal f
        (equiv_smalltype (f x.1 < f a)
           ((equiv_smalltype (f x.1 < f a))^-1
              (simulation_is_hom f
                 (equiv_smalltype (x.1 < a) x.2))))).1 <
     a))^-1
   (fst
      (simulation_is_minimal f
         (equiv_smalltype (f x.1 < f a)
            ((equiv_smalltype (f x.1 < f a))^-1
               (simulation_is_hom f
                  (equiv_smalltype (x.1 < a) x.2))))).2))) ==
idmap intros x.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : A & smalltype (b < a)}
((simulation_is_minimal f
    (equiv_smalltype (f x.1 < f a)
       ((equiv_smalltype (f x.1 < f a))^-1
          (simulation_is_hom f
             (equiv_smalltype (x.1 < a) x.2))))).1;
(equiv_smalltype
   ((simulation_is_minimal f
       (equiv_smalltype (f x.1 < f a)
          ((equiv_smalltype (f x.1 < f a))^-1
             (simulation_is_hom f
                (equiv_smalltype (x.1 < a) x.2))))).1 <
    a))^-1
  (fst
     (simulation_is_minimal f
        (equiv_smalltype (f x.1 < f a)
           ((equiv_smalltype (f x.1 < f a))^-1
              (simulation_is_hom f
                 (equiv_smalltype (x.1 < a) x.2))))).2)) =
x apply path_sigma_hprop; cbn.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : A & smalltype (b < a)}
(simulation_is_minimal f
   (equiv_smalltype (f x.1 < f a)
      ((equiv_smalltype (f x.1 < f a))^-1
         (simulation_is_hom f
            (equiv_smalltype (x.1 < a) x.2))))).1 =
x.1
      transparent assert (x_a : (x.1 < a)).
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : A & smalltype (b < a)}
x.1 < a
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : A & smalltype (b < a)}
x_a:= ?Goal: x.1 < a
(simulation_is_minimal f
   (equiv_smalltype 
      (f x.1 < f a)
      ((equiv_smalltype (f x.1 < f a))^-1
         (simulation_is_hom f
            (equiv_smalltype (x.1 < a) x.2))))).1 =
x.1 {
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : A & smalltype (b < a)}
x.1 < a
        exact (equiv_smalltype _ x.2).
      }
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : A & smalltype (b < a)}
x_a:= equiv_smalltype (x.1 < a) x.2: x.1 < a
(simulation_is_minimal f
   (equiv_smalltype (f x.1 < f a)
      ((equiv_smalltype (f x.1 < f a))^-1
         (simulation_is_hom f
            (equiv_smalltype (x.1 < a) x.2))))).1 =
x.1
      apply (injective f).
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : A & smalltype (b < a)}
x_a:= equiv_smalltype (x.1 < a) x.2: x.1 < a
f
  (simulation_is_minimal f
     (equiv_smalltype (f x.1 < f a)
        ((equiv_smalltype (f x.1 < f a))^-1
           (simulation_is_hom f
              (equiv_smalltype (x.1 < a) x.2))))).1 =
f x.1
      cbn.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : A & smalltype (b < a)}
x_a:= equiv_smalltype (x.1 < a) x.2: x.1 < a
f
  (simulation_is_minimal f
     (equiv_smalltype (f x.1 < f a)
        ((equiv_smalltype (f x.1 < f a))^-1
           (simulation_is_hom f
              (equiv_smalltype (x.1 < a) x.2))))).1 =
f x.1 unfold initial_segment_property.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : A & smalltype (b < a)}
x_a:= equiv_smalltype (x.1 < a) x.2: x.1 < a
f
  (simulation_is_minimal f
     (equiv_smalltype (f x.1 < f a)
        ((equiv_smalltype (f x.1 < f a))^-1
           (simulation_is_hom f
              (equiv_smalltype (x.1 < a) x.2))))).1 =
f x.1 cbn.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : A & smalltype (b < a)}
x_a:= equiv_smalltype (x.1 < a) x.2: x.1 < a
f
  (simulation_is_minimal f
     (equiv_smalltype (f x.1 < f a)
        ((equiv_smalltype (f x.1 < f a))^-1
           (simulation_is_hom f
              (equiv_smalltype (x.1 < a) x.2))))).1 =
f x.1
      rewrite eisretr.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
x: {b : A & smalltype (b < a)}
x_a:= equiv_smalltype (x.1 < a) x.2: x.1 < a
f
  (simulation_is_minimal f
     (simulation_is_hom f
        (equiv_smalltype (x.1 < a) x.2))).1 = f x.1
      exact (snd (simulation_is_minimal f (simulation_is_hom f x_a)).2).
  -
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
(fun f0 : (↓a).1 <~> (↓(f a)).1 =>
 forall a0 a' : (↓a).1,
 (↓a).2 a0 a' <-> (↓(f a)).2 (f0 a0) (f0 a'))
  (equiv_adjointify
     (fun x : ↓a =>
      (f x.1;
      (equiv_smalltype (f x.1 < f a))^-1
        (simulation_is_hom f
           (let X :=
              equiv_fun (equiv_smalltype (x.1 < a)) in
            X x.2))))
     (fun x : ↓(f a) =>
      let x_fa := equiv_smalltype (x.1 < f a) x.2 in
      let s := simulation_is_minimal f x_fa in
      (fun (a' : A) (proj2 : (a' < a) * (f a' = x.1))
       =>
       (fun (a'_a : a' < a) (_ : f a' = x.1) =>
        (a'; (equiv_smalltype (a' < a))^-1 a'_a))
         (fst proj2) (snd proj2)) s.1 s.2)
     (((fun x : {b : B & smalltype (b < f a)} =>
        path_sigma_hprop
          (f
             (simulation_is_minimal f
                (equiv_smalltype (x.1 < f a) x.2)).1;
          (equiv_smalltype
             (f
                (simulation_is_minimal f
                   (equiv_smalltype (x.1 < f a) x.2)).1 <
              f a))^-1
            (simulation_is_hom f
               (equiv_smalltype
                  ((simulation_is_minimal f
                      (equiv_smalltype (x.1 < f a) x.2)).1 <
                   a)
                  ((equiv_smalltype
                      ((simulation_is_minimal f
                          (equiv_smalltype (...) x.2)).1 <
                       a))^-1
                     (fst
                        (simulation_is_minimal f
                           (equiv_smalltype
                              (x.1 < f a) x.2)).2)))))
          x
          ((let __transparent_assert_hypothesis :=
              equiv_smalltype (x.1 < f a) x.2 in
            snd
              (simulation_is_minimal f
                 __transparent_assert_hypothesis).2)
           :
           (f
              (simulation_is_minimal f
                 (equiv_smalltype (x.1 < f a) x.2)).1;
           (equiv_smalltype
              (f
                 (simulation_is_minimal f
                    (equiv_smalltype (x.1 < f a) x.2)).1 <
               f a))^-1
             (simulation_is_hom f
                (equiv_smalltype
                   ((simulation_is_minimal f
                       (equiv_smalltype (x.1 < ...)
                          x.2)).1 < a)
                   ((equiv_smalltype
                       ((simulation_is_minimal f ...).1 <
                        a))^-1
                      (fst
                         (simulation_is_minimal f
                            (equiv_smalltype ... x.2)).2))))).1 =
           x.1))
       :
       (fun x : {b : B & smalltype (b < f a)} =>
        (f
           (simulation_is_minimal f
              (equiv_smalltype (x.1 < f a) x.2)).1;
        (equiv_smalltype
           (f
              (simulation_is_minimal f
                 (equiv_smalltype (x.1 < f a) x.2)).1 <
            f a))^-1
          (simulation_is_hom f
             (equiv_smalltype
                ((simulation_is_minimal f
                    (equiv_smalltype (x.1 < f a) x.2)).1 <
                 a)
                ((equiv_smalltype
                    ((simulation_is_minimal f
                        (equiv_smalltype (...) x.2)).1 <
                     a))^-1
                   (fst
                      (simulation_is_minimal f
                         (equiv_smalltype (x.1 < f a)
                            x.2)).2)))))) == idmap)
      :
      (fun x : ↓a =>
       (f x.1;
       (equiv_smalltype (f x.1 < f a))^-1
         (simulation_is_hom f
            (let X :=
               equiv_fun (equiv_smalltype (x.1 < a))
               in
             X x.2))))
      o (fun x : ↓(f a) =>
         let x_fa := equiv_smalltype (x.1 < f a) x.2
           in
         let s := simulation_is_minimal f x_fa in
         (fun (a' : A)
            (proj2 : (a' < a) * (f a' = x.1)) =>
          (fun (a'_a : a' < a) (_ : f a' = x.1) =>
           (a'; (equiv_smalltype (a' < a))^-1 a'_a))
            (fst proj2) (snd proj2)) s.1 s.2) == idmap)
     (((fun x : {b : A & smalltype (b < a)} =>
        path_sigma_hprop
          ((simulation_is_minimal f
              (equiv_smalltype (f x.1 < f a)
                 ((equiv_smalltype (f x.1 < f a))^-1
                    (simulation_is_hom f
                       (equiv_smalltype (x.1 < a) x.2))))).1;
          (equiv_smalltype
             ((simulation_is_minimal f
                 (equiv_smalltype (f x.1 < f a)
                    ((equiv_smalltype (f x.1 < f a))^-1
                       (simulation_is_hom f
                          (equiv_smalltype (...) x.2))))).1 <
              a))^-1
            (fst
               (simulation_is_minimal f
                  (equiv_smalltype (f x.1 < f a)
                     ((equiv_smalltype (f x.1 < f a))^-1
                        (simulation_is_hom f
                           (equiv_smalltype (x.1 < a)
                              x.2))))).2)) x
          ((let __transparent_assert_hypothesis :=
              equiv_smalltype (x.1 < a) x.2 in
            injective f
              (simulation_is_minimal f
                 (equiv_smalltype (f x.1 < f a)
                    ((equiv_smalltype (f x.1 < f a))^-1
                       (simulation_is_hom f
                          (equiv_smalltype (x.1 < a)
                             x.2))))).1 x.1
              (((internal_paths_rew_r
                   (fun l : ... < ... =>
                    f (...).1 = f x.1)
                   (snd
                      (simulation_is_minimal f (...)).2)
                   (eisretr (equiv_smalltype (...))
                      (simulation_is_hom f (...)))
                 :
                 f
                   (simulation_is_minimal f
                      (equiv_smalltype ... ...)).1 =
                 f x.1)
                :
                f
                  (simulation_is_minimal f
                     (equiv_smalltype (... < ...)
                        (...^-1 ...))).1 = f x.1)
               :
               f
                 (simulation_is_minimal f
                    (equiv_smalltype (f x.1 < f a)
                       ((equiv_smalltype ...)^-1
                          (simulation_is_hom f ...)))).1 =
               f x.1))
           :
           ((simulation_is_minimal f
               (equiv_smalltype (f x.1 < f a)
                  ((equiv_smalltype (f x.1 < f a))^-1
                     (simulation_is_hom f
                        (equiv_smalltype (x.1 < a) x.2))))).1;
           (equiv_smalltype
              ((simulation_is_minimal f
                  (equiv_smalltype (f x.1 < f a)
                     ((equiv_smalltype ...)^-1
                        (simulation_is_hom f ...)))).1 <
               a))^-1
             (fst
                (simulation_is_minimal f
                   (equiv_smalltype (f x.1 < f a)
                      ((equiv_smalltype (... < ...))^-1
                         (simulation_is_hom f
                            (equiv_smalltype ... x.2))))).2)).1 =
           x.1))
       :
       (fun x : {b : A & smalltype (b < a)} =>
        ((simulation_is_minimal f
            (equiv_smalltype (f x.1 < f a)
               ((equiv_smalltype (f x.1 < f a))^-1
                  (simulation_is_hom f
                     (equiv_smalltype (x.1 < a) x.2))))).1;
        (equiv_smalltype
           ((simulation_is_minimal f
               (equiv_smalltype (f x.1 < f a)
                  ((equiv_smalltype (f x.1 < f a))^-1
                     (simulation_is_hom f
                        (equiv_smalltype (...) x.2))))).1 <
            a))^-1
          (fst
             (simulation_is_minimal f
                (equiv_smalltype (f x.1 < f a)
                   ((equiv_smalltype (f x.1 < f a))^-1
                      (simulation_is_hom f
                         (equiv_smalltype (x.1 < a)
                            x.2))))).2))) == idmap)
      :
      (fun x : ↓(f a) =>
       let x_fa := equiv_smalltype (x.1 < f a) x.2 in
       let s := simulation_is_minimal f x_fa in
       (fun (a' : A) (proj2 : (a' < a) * (f a' = x.1))
        =>
        (fun (a'_a : a' < a) (_ : f a' = x.1) =>
         (a'; (equiv_smalltype (a' < a))^-1 a'_a))
          (fst proj2) (snd proj2)) s.1 s.2)
      o (fun x : ↓a =>
         (f x.1;
         (equiv_smalltype (f x.1 < f a))^-1
           (simulation_is_hom f
              (let X :=
                 equiv_fun (equiv_smalltype (x.1 < a))
                 in
               X x.2)))) == idmap)) cbn.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
forall a0 a' : {b : A & smalltype (b < a)},
a0.1 < a'.1 <-> f a0.1 < f a'.1 intros [x x_a] [y y_a]; cbn.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a, x: A
x_a: smalltype (x < a)
y: A
y_a: smalltype (y < a)
x < y <-> f x < f y split.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a, x: A
x_a: smalltype (x < a)
y: A
y_a: smalltype (y < a)
x < y -> f x < f y
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a, x: A
x_a: smalltype (x < a)
y: A
y_a: smalltype (y < a)
f x < f y -> x < y
    +
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a, x: A
x_a: smalltype (x < a)
y: A
y_a: smalltype (y < a)
x < y -> f x < f y exact (simulation_is_hom f).
    +
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a, x: A
x_a: smalltype (x < a)
y: A
y_a: smalltype (y < a)
f x < f y -> x < y intros fx_fy.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a, x: A
x_a: smalltype (x < a)
y: A
y_a: smalltype (y < a)
fx_fy: f x < f y
x < y
      destruct (simulation_is_minimal f fx_fy) as (a' & a'_y & p).
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a, x: A
x_a: smalltype (x < a)
y: A
y_a: smalltype (y < a)
fx_fy: f x < f y
a': A
a'_y: a' < y
p: f a' = f x
x < y
      apply injective in p; try exact _.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a, x: A
x_a: smalltype (x < a)
y: A
y_a: smalltype (y < a)
fx_fy: f x < f y
a': A
a'_y: a' < y
p: a' = x
x < y subst a'.
H: PropResizing
A: Type
R: Lt A
H0: IsOrdinal A R
B: Type
Q: Lt B
H1: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a, x: A
x_a: smalltype (x < a)
y: A
y_a: smalltype (y < a)
fx_fy: f x < f y
a'_y: x < y
x < y exact a'_y.
Qed.

Lemma path_initial_segment_simulation `{Univalence}
      `{PropResizing}
      {A : Type} {R : Lt A} `{IsOrdinal A R}
      {B : Type} {Q : Lt B} `{IsOrdinal B Q}
      (f : A -> B) {is_simulation : IsSimulation f} (a : A)
  : ↓(f a) = ↓a.
H: Univalence
H0: PropResizing
A: Type
R: Lt A
H1: IsOrdinal A R
B: Type
Q: Lt B
H2: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
↓(f a) = ↓a
Proof.
H: Univalence
H0: PropResizing
A: Type
R: Lt A
H1: IsOrdinal A R
B: Type
Q: Lt B
H2: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
↓(f a) = ↓a
  apply equiv_path_Ordinal.
H: Univalence
H0: PropResizing
A: Type
R: Lt A
H1: IsOrdinal A R
B: Type
Q: Lt B
H2: IsOrdinal B Q
f: A -> B
is_simulation: IsSimulation f
a: A
Isomorphism ↓(f a) ↓a apply (equiv_initial_segment_simulation f).
Qed.

(** * `Ordinal` is an ordinal *)

Instance lt_Ordinal@{carrier relation +} `{PropResizing}
  : Lt Ordinal@{carrier relation}
  := fun A B => exists b : B, A = ↓b.

Instance is_mere_relation_lt_on_Ordinal `{Univalence} `{PropResizing}
  : is_mere_relation Ordinal lt_Ordinal.
H: Univalence
H0: PropResizing
is_mere_relation Ordinal lt_Ordinal
Proof.
H: Univalence
H0: PropResizing
is_mere_relation Ordinal lt_Ordinal
  intros A B.
H: Univalence
H0: PropResizing
A, B: Ordinal
IsHProp (lt_Ordinal A B)
  apply ishprop_sigma_disjoint.
H: Univalence
H0: PropResizing
A, B: Ordinal
forall x y : B, A = ↓x -> A = ↓y -> x = y
  intros b b' -> p.
H: Univalence
H0: PropResizing
B: Ordinal
b, b': B
p: ↓b = ↓b'
b = b' apply (injective initial_segment).
H: Univalence
H0: PropResizing
B: Ordinal
b, b': B
p: ↓b = ↓b'
↓b = ↓b' exact p.
Qed.

Definition bound `{PropResizing}
  {A B : Ordinal} (H : A < B)
  : B
  := H.1.

(* We use this notation to hide the proof of A < B that `bound` takes as an argument *)
Notation "A ◁ B" := (@bound A B _) (at level 70) : Ordinals.

Definition bound_property `{PropResizing}
  {A B : Ordinal} (H : A < B)
  : A = ↓(bound H)
  := H.2.

Lemma isembedding_initial_segment `{PropResizing} `{Univalence}
  {A : Ordinal} (a b : A)
  : a < b <-> ↓a < ↓b.
H: PropResizing
H0: Univalence
A: Ordinal
a, b: A
a < b <-> ↓a < ↓b
Proof.
H: PropResizing
H0: Univalence
A: Ordinal
a, b: A
a < b <-> ↓a < ↓b
  split.
H: PropResizing
H0: Univalence
A: Ordinal
a, b: A
a < b -> ↓a < ↓b
H: PropResizing
H0: Univalence
A: Ordinal
a, b: A
↓a < ↓b -> a < b
  -
H: PropResizing
H0: Univalence
A: Ordinal
a, b: A
a < b -> ↓a < ↓b intros a_b.
H: PropResizing
H0: Univalence
A: Ordinal
a, b: A
a_b: a < b
↓a < ↓b exists (in_ a a_b).
H: PropResizing
H0: Univalence
A: Ordinal
a, b: A
a_b: a < b
↓a = ↓(in_ a a_b)
    exact (path_initial_segment_simulation out (in_ a a_b)).
  -
H: PropResizing
H0: Univalence
A: Ordinal
a, b: A
↓a < ↓b -> a < b intros a_b.
H: PropResizing
H0: Univalence
A: Ordinal
a, b: A
a_b: ↓a < ↓b
a < b
    assert (a = out (bound a_b))
           as ->.
H: PropResizing
H0: Univalence
A: Ordinal
a, b: A
a_b: ↓a < ↓b
a = out ((H ◁ ↓a) a_b)
H: PropResizing
H0: Univalence
A: Ordinal
a, b: A
a_b: ↓a < ↓b
out ((H ◁ ↓a) a_b) < b {
H: PropResizing
H0: Univalence
A: Ordinal
a, b: A
a_b: ↓a < ↓b
a = out ((H ◁ ↓a) a_b)
      apply (injective initial_segment).
H: PropResizing
H0: Univalence
A: Ordinal
a, b: A
a_b: ↓a < ↓b
↓a = ↓(out ((H ◁ ↓a) a_b))
      rewrite (path_initial_segment_simulation out).
H: PropResizing
H0: Univalence
A: Ordinal
a, b: A
a_b: ↓a < ↓b
↓a = ↓((H ◁ ↓a) a_b)
      apply bound_property.
    }
H: PropResizing
H0: Univalence
A: Ordinal
a, b: A
a_b: ↓a < ↓b
out ((H ◁ ↓a) a_b) < b
    apply initial_segment_property.
Qed.

Instance Ordinal_is_ordinal `{PropResizing} `{Univalence}
  : IsOrdinal Ordinal (<).
H: PropResizing
H0: Univalence
IsOrdinal Ordinal lt
Proof.
H: PropResizing
H0: Univalence
IsOrdinal Ordinal lt
  constructor.
H: PropResizing
H0: Univalence
IsHSet Ordinal
H: PropResizing
H0: Univalence
is_mere_relation Ordinal lt
H: PropResizing
H0: Univalence
Extensional lt
H: PropResizing
H0: Univalence
WellFounded lt
H: PropResizing
H0: Univalence
Transitive lt
  -
H: PropResizing
H0: Univalence
IsHSet Ordinal exact _.
  -
H: PropResizing
H0: Univalence
is_mere_relation Ordinal lt exact is_mere_relation_lt_on_Ordinal.
  -
H: PropResizing
H0: Univalence
Extensional lt intros A B H1.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
A = B
    srapply path_Ordinal.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
A <~> B
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
forall a a' : A, a < a' <-> ?f a < ?f a'
    +
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
A <~> B srapply equiv_adjointify.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
A -> B
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
B -> A
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
?f o ?g == idmap
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
?g o ?f == idmap
      *
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
A -> B assert (lt_B : forall a : A, ↓a < B).
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
forall a : A, ↓a < B
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
lt_B: forall a : A, ↓a < B
A -> B {
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
forall a : A, ↓a < B
          intros a.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a: A
↓a < B apply H1.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a: A
↓a < A exists a.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a: A
↓a = ↓a reflexivity.
        }
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
lt_B: forall a : A, ↓a < B
A -> B
        exact (fun a => bound (lt_B a)).
      *
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
B -> A assert (lt_A : forall b : B, ↓b < A).
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
forall b : B, ↓b < A
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
lt_A: forall b : B, ↓b < A
B -> A {
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
forall b : B, ↓b < A
          intros b.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
b: B
↓b < A apply H1.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
b: B
↓b < B exists b.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
b: B
↓b = ↓b reflexivity.
        }
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
lt_A: forall b : B, ↓b < A
B -> A
        exact (fun b => bound (lt_A b)).
      *
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
(let lt_B :=
   fun a : A =>
   let X := fun c : Ordinal => fst (H1 c) in
   X ↓a (a; 1%path) in
 fun a : A => (H ◁ ↓a) (lt_B a))
o (let lt_A :=
     fun b : B =>
     let X := fun c : Ordinal => snd (H1 c) in
     X ↓b (b; 1%path) in
   fun b : B => (H ◁ ↓b) (lt_A b)) == idmap cbn.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
(fun x : ordinal_carrier B =>
 (H ◁ ↓((H ◁ ↓x) (snd (H1 ↓x) (x; 1%path))))
   (fst (H1 ↓((H ◁ ↓x) (snd (H1 ↓x) (x; 1%path))))
      ((H ◁ ↓x) (snd (H1 ↓x) (x; 1%path)); 1%path))) ==
idmap intros b.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
b: ordinal_carrier B
(H ◁ ↓((H ◁ ↓b) (snd (H1 ↓b) (b; 1%path))))
  (fst (H1 ↓((H ◁ ↓b) (snd (H1 ↓b) (b; 1%path))))
     ((H ◁ ↓b) (snd (H1 ↓b) (b; 1%path)); 1%path)) = b apply (injective initial_segment).
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
b: ordinal_carrier B
↓((H ◁ ↓((H ◁ ↓b) (snd (H1 ↓b) (b; 1%path))))
    (fst (H1 ↓((H ◁ ↓b) (snd (H1 ↓b) (b; 1%path))))
       ((H ◁ ↓b) (snd (H1 ↓b) (b; 1%path)); 1%path))) =
↓b
        repeat rewrite <- bound_property.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
b: ordinal_carrier B
↓b = ↓b reflexivity.
      *
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
(let lt_A :=
   fun b : B =>
   let X := fun c : Ordinal => snd (H1 c) in
   X ↓b (b; 1%path) in
 fun b : B => (H ◁ ↓b) (lt_A b))
o (let lt_B :=
     fun a : A =>
     let X := fun c : Ordinal => fst (H1 c) in
     X ↓a (a; 1%path) in
   fun a : A => (H ◁ ↓a) (lt_B a)) == idmap cbn.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
(fun x : ordinal_carrier A =>
 (H ◁ ↓((H ◁ ↓x) (fst (H1 ↓x) (x; 1%path))))
   (snd (H1 ↓((H ◁ ↓x) (fst (H1 ↓x) (x; 1%path))))
      ((H ◁ ↓x) (fst (H1 ↓x) (x; 1%path)); 1%path))) ==
idmap intros a.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a: ordinal_carrier A
(H ◁ ↓((H ◁ ↓a) (fst (H1 ↓a) (a; 1%path))))
  (snd (H1 ↓((H ◁ ↓a) (fst (H1 ↓a) (a; 1%path))))
     ((H ◁ ↓a) (fst (H1 ↓a) (a; 1%path)); 1%path)) = a apply (injective initial_segment).
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a: ordinal_carrier A
↓((H ◁ ↓((H ◁ ↓a) (fst (H1 ↓a) (a; 1%path))))
    (snd (H1 ↓((H ◁ ↓a) (fst (H1 ↓a) (a; 1%path))))
       ((H ◁ ↓a) (fst (H1 ↓a) (a; 1%path)); 1%path))) =
↓a
        repeat rewrite <- bound_property.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a: ordinal_carrier A
↓a = ↓a reflexivity.
    +
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
forall a a' : A,
a < a' <->
equiv_adjointify
  (let lt_B :=
     fun a0 : A =>
     let X := fun c : Ordinal => fst (H1 c) in
     X ↓a0 (a0; 1%path) in
   fun a0 : A => (H ◁ ↓a0) (lt_B a0))
  (let lt_A :=
     fun b : B =>
     let X := fun c : Ordinal => snd (H1 c) in
     X ↓b (b; 1%path) in
   fun b : B => (H ◁ ↓b) (lt_A b))
  (((fun b : ordinal_carrier B =>
     injective initial_segment
       ((H ◁ ↓((H ◁ ↓b) (snd (H1 ↓b) (b; 1%path))))
          (fst
             (H1 ↓((H ◁ ↓b) (snd (H1 ↓b) (b; 1%path))))
             ((H ◁ ↓b) (snd (H1 ↓b) (b; 1%path));
             1%path))) b
       (internal_paths_rew (fun o : Ordinal => o = ↓b)
          (internal_paths_rew
             (fun o : Ordinal => o = ↓b) 1%path
             (bound_property (snd (H1 ↓b) (b; 1%path))))
          (bound_property
             (fst
                (H1
                   ↓((H ◁ ↓b)
                       (snd (H1 ↓b) (b; 1%path))))
                ((H ◁ ↓b) (snd (H1 ↓b) (b; 1%path));
                1%path)))))
    :
    (fun x : ordinal_carrier B =>
     (H ◁ ↓((H ◁ ↓x) (snd (H1 ↓x) (x; 1%path))))
       (fst (H1 ↓((H ◁ ↓x) (snd (H1 ↓x) (x; 1%path))))
          ((H ◁ ↓x) (snd (H1 ↓x) (x; 1%path)); 1%path))) ==
    idmap)
   :
   (let lt_B :=
      fun a0 : A =>
      let X := fun c : Ordinal => fst (H1 c) in
      X ↓a0 (a0; 1%path) in
    fun a0 : A => (H ◁ ↓a0) (lt_B a0))
   o (let lt_A :=
        fun b : B =>
        let X := fun c : Ordinal => snd (H1 c) in
        X ↓b (b; 1%path) in
      fun b : B => (H ◁ ↓b) (lt_A b)) == idmap)
  (((fun a0 : ordinal_carrier A =>
     injective initial_segment
       ((H ◁ ↓((H ◁ ↓a0) (fst (H1 ↓a0) (a0; 1%path))))
          (snd
             (H1
                ↓((H ◁ ↓a0)
                    (fst (H1 ↓a0) (a0; 1%path))))
             ((H ◁ ↓a0) (fst (H1 ↓a0) (a0; 1%path));
             1%path))) a0
       (internal_paths_rew
          (fun o : Ordinal => o = ↓a0)
          (internal_paths_rew
             (fun o : Ordinal => o = ↓a0) 1%path
             (bound_property
                (fst (H1 ↓a0) (a0; 1%path))))
          (bound_property
             (snd
                (H1
                   ↓((H ◁ ↓a0)
                       (fst (H1 ↓a0) (a0; 1%path))))
                ((H ◁ ↓a0) (fst (H1 ↓a0) (a0; 1%path));
                1%path)))))
    :
    (fun x : ordinal_carrier A =>
     (H ◁ ↓((H ◁ ↓x) (fst (H1 ↓x) (x; 1%path))))
       (snd (H1 ↓((H ◁ ↓x) (fst (H1 ↓x) (x; 1%path))))
          ((H ◁ ↓x) (fst (H1 ↓x) (x; 1%path)); 1%path))) ==
    idmap)
   :
   (let lt_A :=
      fun b : B =>
      let X := fun c : Ordinal => snd (H1 c) in
      X ↓b (b; 1%path) in
    fun b : B => (H ◁ ↓b) (lt_A b))
   o (let lt_B :=
        fun a0 : A =>
        let X := fun c : Ordinal => fst (H1 c) in
        X ↓a0 (a0; 1%path) in
      fun a0 : A => (H ◁ ↓a0) (lt_B a0)) == idmap) a <
equiv_adjointify
  (let lt_B :=
     fun a0 : A =>
     let X := fun c : Ordinal => fst (H1 c) in
     X ↓a0 (a0; 1%path) in
   fun a0 : A => (H ◁ ↓a0) (lt_B a0))
  (let lt_A :=
     fun b : B =>
     let X := fun c : Ordinal => snd (H1 c) in
     X ↓b (b; 1%path) in
   fun b : B => (H ◁ ↓b) (lt_A b))
  (((fun b : ordinal_carrier B =>
     injective initial_segment
       ((H ◁ ↓((H ◁ ↓b) (snd (H1 ↓b) (b; 1%path))))
          (fst
             (H1 ↓((H ◁ ↓b) (snd (H1 ↓b) (b; 1%path))))
             ((H ◁ ↓b) (snd (H1 ↓b) (b; 1%path));
             1%path))) b
       (internal_paths_rew (fun o : Ordinal => o = ↓b)
          (internal_paths_rew
             (fun o : Ordinal => o = ↓b) 1%path
             (bound_property (snd (H1 ↓b) (b; 1%path))))
          (bound_property
             (fst
                (H1
                   ↓((H ◁ ↓b)
                       (snd (H1 ↓b) (b; 1%path))))
                ((H ◁ ↓b) (snd (H1 ↓b) (b; 1%path));
                1%path)))))
    :
    (fun x : ordinal_carrier B =>
     (H ◁ ↓((H ◁ ↓x) (snd (H1 ↓x) (x; 1%path))))
       (fst (H1 ↓((H ◁ ↓x) (snd (H1 ↓x) (x; 1%path))))
          ((H ◁ ↓x) (snd (H1 ↓x) (x; 1%path)); 1%path))) ==
    idmap)
   :
   (let lt_B :=
      fun a0 : A =>
      let X := fun c : Ordinal => fst (H1 c) in
      X ↓a0 (a0; 1%path) in
    fun a0 : A => (H ◁ ↓a0) (lt_B a0))
   o (let lt_A :=
        fun b : B =>
        let X := fun c : Ordinal => snd (H1 c) in
        X ↓b (b; 1%path) in
      fun b : B => (H ◁ ↓b) (lt_A b)) == idmap)
  (((fun a0 : ordinal_carrier A =>
     injective initial_segment
       ((H ◁ ↓((H ◁ ↓a0) (fst (H1 ↓a0) (a0; 1%path))))
          (snd
             (H1
                ↓((H ◁ ↓a0)
                    (fst (H1 ↓a0) (a0; 1%path))))
             ((H ◁ ↓a0) (fst (H1 ↓a0) (a0; 1%path));
             1%path))) a0
       (internal_paths_rew
          (fun o : Ordinal => o = ↓a0)
          (internal_paths_rew
             (fun o : Ordinal => o = ↓a0) 1%path
             (bound_property
                (fst (H1 ↓a0) (a0; 1%path))))
          (bound_property
             (snd
                (H1
                   ↓((H ◁ ↓a0)
                       (fst (H1 ↓a0) (a0; 1%path))))
                ((H ◁ ↓a0) (fst (H1 ↓a0) (a0; 1%path));
                1%path)))))
    :
    (fun x : ordinal_carrier A =>
     (H ◁ ↓((H ◁ ↓x) (fst (H1 ↓x) (x; 1%path))))
       (snd (H1 ↓((H ◁ ↓x) (fst (H1 ↓x) (x; 1%path))))
          ((H ◁ ↓x) (fst (H1 ↓x) (x; 1%path)); 1%path))) ==
    idmap)
   :
   (let lt_A :=
      fun b : B =>
      let X := fun c : Ordinal => snd (H1 c) in
      X ↓b (b; 1%path) in
    fun b : B => (H ◁ ↓b) (lt_A b))
   o (let lt_B :=
        fun a0 : A =>
        let X := fun c : Ordinal => fst (H1 c) in
        X ↓a0 (a0; 1%path) in
      fun a0 : A => (H ◁ ↓a0) (lt_B a0)) == idmap) a' cbn.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
forall a a' : ordinal_carrier A,
a < a' <->
(H ◁ ↓a) (fst (H1 ↓a) (a; 1%path)) <
(H ◁ ↓a') (fst (H1 ↓a') (a'; 1%path)) intros a a'.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a, a': ordinal_carrier A
a < a' <->
(H ◁ ↓a) (fst (H1 ↓a) (a; 1%path)) <
(H ◁ ↓a') (fst (H1 ↓a') (a'; 1%path)) split.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a, a': ordinal_carrier A
a < a' ->
(H ◁ ↓a) (fst (H1 ↓a) (a; 1%path)) <
(H ◁ ↓a') (fst (H1 ↓a') (a'; 1%path))
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a, a': ordinal_carrier A
(H ◁ ↓a) (fst (H1 ↓a) (a; 1%path)) <
(H ◁ ↓a') (fst (H1 ↓a') (a'; 1%path)) -> a < a'
      *
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a, a': ordinal_carrier A
a < a' ->
(H ◁ ↓a) (fst (H1 ↓a) (a; 1%path)) <
(H ◁ ↓a') (fst (H1 ↓a') (a'; 1%path)) intros a_a'.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a, a': ordinal_carrier A
a_a': a < a'
(H ◁ ↓a) (fst (H1 ↓a) (a; 1%path)) <
(H ◁ ↓a') (fst (H1 ↓a') (a'; 1%path))
        apply isembedding_initial_segment.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a, a': ordinal_carrier A
a_a': a < a'
↓((H ◁ ↓a) (fst (H1 ↓a) (a; 1%path))) <
↓((H ◁ ↓a') (fst (H1 ↓a') (a'; 1%path)))
        repeat rewrite <- bound_property.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a, a': ordinal_carrier A
a_a': a < a'
↓a < ↓a'
        apply isembedding_initial_segment.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a, a': ordinal_carrier A
a_a': a < a'
a < a'
        assumption.
      *
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a, a': ordinal_carrier A
(H ◁ ↓a) (fst (H1 ↓a) (a; 1%path)) <
(H ◁ ↓a') (fst (H1 ↓a') (a'; 1%path)) -> a < a' intros a_a'.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a, a': ordinal_carrier A
a_a': (H ◁ ↓a) (fst (H1 ↓a) (a; 1%path)) <
(H ◁ ↓a') (fst (H1 ↓a') (a'; 1%path))
a < a'
        apply isembedding_initial_segment in a_a'.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a, a': ordinal_carrier A
a_a': ↓((H ◁ ↓a) (fst (H1 ↓a) (a; 1%path))) <
↓((H ◁ ↓a') (fst (H1 ↓a') (a'; 1%path)))
a < a'
        repeat rewrite <- bound_property in a_a'.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a, a': ordinal_carrier A
a_a': ↓a < ↓a'
a < a'
        apply isembedding_initial_segment in a_a'.
H: PropResizing
H0: Univalence
A, B: Ordinal
H1: forall c : Ordinal, c < A <-> c < B
a, a': ordinal_carrier A
a_a': a < a'
a < a'
        assumption.
  -
H: PropResizing
H0: Univalence
WellFounded lt intros A.
H: PropResizing
H0: Univalence
A: Ordinal
Accessible lt A
    constructor.
H: PropResizing
H0: Univalence
A: Ordinal
forall b : Ordinal, b < A -> Accessible lt b intros ? [a ->].
H: PropResizing
H0: Univalence
A: Ordinal
a: A
Accessible lt ↓a
    induction (well_foundedness a) as [a _ IH].
H: PropResizing
H0: Univalence
A: Ordinal
a: A
IH: forall b : A, b < a -> Accessible lt ↓b
Accessible lt ↓a
    constructor.
H: PropResizing
H0: Univalence
A: Ordinal
a: A
IH: forall b : A, b < a -> Accessible lt ↓b
forall b : Ordinal, b < ↓a -> Accessible lt b intros ? [x ->].
H: PropResizing
H0: Univalence
A: Ordinal
a: A
IH: forall b : A, b < a -> Accessible lt ↓b
x: ↓a
Accessible lt ↓x
    rewrite <- (path_initial_segment_simulation out).
H: PropResizing
H0: Univalence
A: Ordinal
a: A
IH: forall b : A, b < a -> Accessible lt ↓b
x: ↓a
Accessible lt ↓(out x)
    apply IH.
H: PropResizing
H0: Univalence
A: Ordinal
a: A
IH: forall b : A, b < a -> Accessible lt ↓b
x: ↓a
out x < a apply initial_segment_property.
  -
H: PropResizing
H0: Univalence
Transitive lt intros ? ? A [x ->] [a ->].
H: PropResizing
H0: Univalence
A: Ordinal
a: A
x: ↓a
↓x < A exists (out x).
H: PropResizing
H0: Univalence
A: Ordinal
a: A
x: ↓a
↓x = ↓(out x)
    rewrite (path_initial_segment_simulation out).
H: PropResizing
H0: Univalence
A: Ordinal
a: A
x: ↓a
↓x = ↓x
    reflexivity.
Qed.


(* This is analogous to the set-theoretic statement that an ordinal is the set of all smaller ordinals. *)
Lemma isomorphism_to_initial_segment `{PropResizing} `{Univalence}
  (B : Ordinal@{A _})
  : Isomorphism B ↓B.
H: PropResizing
H0: Univalence
B: Ordinal
Isomorphism B ↓B
Proof.
H: PropResizing
H0: Univalence
B: Ordinal
Isomorphism B ↓B
  srapply exist.
H: PropResizing
H0: Univalence
B: Ordinal
B.1 <~> (↓B).1
H: PropResizing
H0: Univalence
B: Ordinal
(fun f : B.1 <~> (↓B).1 =>
 forall a a' : B.1, B.2 a a' <-> (↓B).2 (f a) (f a'))
  ?proj1
  -
H: PropResizing
H0: Univalence
B: Ordinal
B.1 <~> (↓B).1 srapply equiv_adjointify.
H: PropResizing
H0: Univalence
B: Ordinal
B -> ↓B
H: PropResizing
H0: Univalence
B: Ordinal
↓B -> B
H: PropResizing
H0: Univalence
B: Ordinal
?f o ?g == idmap
H: PropResizing
H0: Univalence
B: Ordinal
?g o ?f == idmap
    +
H: PropResizing
H0: Univalence
B: Ordinal
B -> ↓B intros b.
H: PropResizing
H0: Univalence
B: Ordinal
b: B
↓B exists ↓b.
H: PropResizing
H0: Univalence
B: Ordinal
b: B
smalltype (↓b < B)
      apply equiv_smalltype.
H: PropResizing
H0: Univalence
B: Ordinal
b: B
↓b < B
      exists b.
H: PropResizing
H0: Univalence
B: Ordinal
b: B
↓b = ↓b reflexivity.
    +
H: PropResizing
H0: Univalence
B: Ordinal
↓B -> B intros [C HC].
H: PropResizing
H0: Univalence
B, C: Ordinal
HC: smalltype (C < B)
B eapply equiv_smalltype in HC.
H: PropResizing
H0: Univalence
B, C: Ordinal
HC: C < B
B
      exact (bound HC).
    +
H: PropResizing
H0: Univalence
B: Ordinal
(fun b : B =>
 (↓b;
 let X :=
   fun (X : Type) (IsSmall : IsSmall X) =>
   equiv_isequiv (equiv_smalltype X) in
 let X0 :=
   fun (X0 : Type) (IsSmall : IsSmall X0) =>
   (equiv_smalltype X0)^-1 in
 X0 (↓b < B)
   (issmall_hprop (↓b < B)
      (ordinal_relation_is_mere ↓b B)) (b; 1%path)))
o (fun X : ↓B =>
   (fun (C : Ordinal) (HC : smalltype (C < B)) =>
    let X0 :=
      fun (X0 : Type) (IsSmall : IsSmall X0) =>
      equiv_fun (equiv_smalltype X0) in
    let HC0 :=
      X0 (C < B)
        (issmall_hprop (C < B)
           (ordinal_relation_is_mere C B)) HC in
    (H ◁ C) HC0) X.1 X.2) == idmap cbn.
H: PropResizing
H0: Univalence
B: Ordinal
(fun x : {b : Ordinal & smalltype (b < B)} =>
 (↓((H ◁ x.1) (equiv_smalltype (x.1 < B) x.2));
 (equiv_smalltype
    (↓((H ◁ x.1) (equiv_smalltype (x.1 < B) x.2)) < B))^-1
   ((H ◁ x.1) (equiv_smalltype (x.1 < B) x.2); 1%path))) ==
idmap intros [C HC].
H: PropResizing
H0: Univalence
B, C: Ordinal
HC: smalltype (C < B)
(↓((H ◁ C) (equiv_smalltype (C < B) HC));
(equiv_smalltype
   (↓((H ◁ C) (equiv_smalltype (C < B) HC)) < B))^-1
  ((H ◁ C) (equiv_smalltype (C < B) HC); 1%path)) =
(C; HC) apply path_sigma_hprop; cbn.
H: PropResizing
H0: Univalence
B, C: Ordinal
HC: smalltype (C < B)
↓((H ◁ C) (equiv_smalltype (C < B) HC)) = C
      symmetry.
H: PropResizing
H0: Univalence
B, C: Ordinal
HC: smalltype (C < B)
C = ↓((H ◁ C) (equiv_smalltype (C < B) HC)) apply bound_property.
    +
H: PropResizing
H0: Univalence
B: Ordinal
(fun X : ↓B =>
 (fun (C : Ordinal) (HC : smalltype (C < B)) =>
  let X0 :=
    fun (X0 : Type) (IsSmall : IsSmall X0) =>
    equiv_fun (equiv_smalltype X0) in
  let HC0 :=
    X0 (C < B)
      (issmall_hprop (C < B)
         (ordinal_relation_is_mere C B)) HC in
  (H ◁ C) HC0) X.1 X.2)
o (fun b : B =>
   (↓b;
   let X :=
     fun (X : Type) (IsSmall : IsSmall X) =>
     equiv_isequiv (equiv_smalltype X) in
   let X0 :=
     fun (X0 : Type) (IsSmall : IsSmall X0) =>
     (equiv_smalltype X0)^-1 in
   X0 (↓b < B)
     (issmall_hprop (↓b < B)
        (ordinal_relation_is_mere ↓b B)) (b; 1%path))) ==
idmap cbn.
H: PropResizing
H0: Univalence
B: Ordinal
(fun x : ordinal_carrier B =>
 (H ◁ ↓x)
   (equiv_smalltype (↓x < B)
      ((equiv_smalltype (↓x < B))^-1 (x; 1%path)))) ==
idmap intros x.
H: PropResizing
H0: Univalence
B: Ordinal
x: ordinal_carrier B
(H ◁ ↓x)
  (equiv_smalltype (↓x < B)
     ((equiv_smalltype (↓x < B))^-1 (x; 1%path))) = x rewrite eisretr.
H: PropResizing
H0: Univalence
B: Ordinal
x: ordinal_carrier B
(H ◁ ↓x) (x; 1%path) = x reflexivity.
  -
H: PropResizing
H0: Univalence
B: Ordinal
(fun f : B.1 <~> (↓B).1 =>
 forall a a' : B.1, B.2 a a' <-> (↓B).2 (f a) (f a'))
  (equiv_adjointify
     (fun b : B =>
      (↓b;
      let X :=
        fun (X : Type) (IsSmall : IsSmall X) =>
        equiv_isequiv (equiv_smalltype X) in
      let X0 :=
        fun (X0 : Type) (IsSmall : IsSmall X0) =>
        (equiv_smalltype X0)^-1 in
      X0 (↓b < B)
        (issmall_hprop (↓b < B)
           (ordinal_relation_is_mere ↓b B))
        (b; 1%path)))
     (fun X : ↓B =>
      (fun (C : Ordinal) (HC : smalltype (C < B)) =>
       let X0 :=
         fun (X0 : Type) (IsSmall : IsSmall X0) =>
         equiv_fun (equiv_smalltype X0) in
       let HC0 :=
         X0 (C < B)
           (issmall_hprop (C < B)
              (ordinal_relation_is_mere C B)) HC in
       (H ◁ C) HC0) X.1 X.2)
     (((fun x : {b : Ordinal & smalltype (b < B)} =>
        (fun (C : Ordinal) (HC : smalltype (C < B)) =>
         path_sigma_hprop
           (↓((H ◁ C) (equiv_smalltype (C < B) HC));
           (equiv_smalltype
              (↓((H ◁ C) (equiv_smalltype (C < B) HC)) <
               B))^-1
             ((H ◁ C) (equiv_smalltype (C < B) HC);
             1%path)) (C; HC)
           ((bound_property
               (equiv_smalltype (C < B) HC))^
            :
            (↓((H ◁ C) (equiv_smalltype (C < B) HC));
            (equiv_smalltype
               (↓((H ◁ C) (equiv_smalltype (...) HC)) <
                B))^-1
              ((H ◁ C) (equiv_smalltype (C < B) HC);
              1%path)).1 = (C; HC).1)) x.1 x.2)
       :
       (fun x : {b : Ordinal & smalltype (b < B)} =>
        (↓((H ◁ x.1) (equiv_smalltype (x.1 < B) x.2));
        (equiv_smalltype
           (↓((H ◁ x.1)
                (equiv_smalltype (x.1 < B) x.2)) < B))^-1
          ((H ◁ x.1) (equiv_smalltype (x.1 < B) x.2);
          1%path))) == idmap)
      :
      (fun b : B =>
       (↓b;
       let X :=
         fun (X : Type) (IsSmall : IsSmall X) =>
         equiv_isequiv (equiv_smalltype X) in
       let X0 :=
         fun (X0 : Type) (IsSmall : IsSmall X0) =>
         (equiv_smalltype X0)^-1 in
       X0 (↓b < B)
         (issmall_hprop (↓b < B)
            (ordinal_relation_is_mere ↓b B))
         (b; 1%path)))
      o (fun X : ↓B =>
         (fun (C : Ordinal) (HC : smalltype (C < B))
          =>
          let X0 :=
            fun (X0 : Type) (IsSmall : IsSmall X0) =>
            equiv_fun (equiv_smalltype X0) in
          let HC0 :=
            X0 (C < B)
              (issmall_hprop (C < B)
                 (ordinal_relation_is_mere C B)) HC in
          (H ◁ C) HC0) X.1 X.2) == idmap)
     (((fun x : ordinal_carrier B =>
        internal_paths_rew_r
          (fun l : ↓x < B => (H ◁ ↓x) l = x) 1%path
          (eisretr (equiv_smalltype (↓x < B))
             (x; 1%path)))
       :
       (fun x : ordinal_carrier B =>
        (H ◁ ↓x)
          (equiv_smalltype (↓x < B)
             ((equiv_smalltype (↓x < B))^-1
                (x; 1%path)))) == idmap)
      :
      (fun X : ↓B =>
       (fun (C : Ordinal) (HC : smalltype (C < B)) =>
        let X0 :=
          fun (X0 : Type) (IsSmall : IsSmall X0) =>
          equiv_fun (equiv_smalltype X0) in
        let HC0 :=
          X0 (C < B)
            (issmall_hprop (C < B)
               (ordinal_relation_is_mere C B)) HC in
        (H ◁ C) HC0) X.1 X.2)
      o (fun b : B =>
         (↓b;
         let X :=
           fun (X : Type) (IsSmall : IsSmall X) =>
           equiv_isequiv (equiv_smalltype X) in
         let X0 :=
           fun (X0 : Type) (IsSmall : IsSmall X0) =>
           (equiv_smalltype X0)^-1 in
         X0 (↓b < B)
           (issmall_hprop (↓b < B)
              (ordinal_relation_is_mere ↓b B))
           (b; 1%path))) == idmap)) cbn.
H: PropResizing
H0: Univalence
B: Ordinal
forall a a' : ordinal_carrier B, a < a' <-> ↓a < ↓a' intros b b'.
H: PropResizing
H0: Univalence
B: Ordinal
b, b': ordinal_carrier B
b < b' <-> ↓b < ↓b' apply isembedding_initial_segment.
Qed.

(** But an ordinal isn't isomorphic to any initial segment of itself. *)
Lemma ordinal_initial `{PropResizing} `{Univalence} (O : Ordinal) (a : O)
  : Isomorphism O ↓a -> Empty.
H: PropResizing
H0: Univalence
O: Ordinal
a: O
Isomorphism O ↓a -> Empty
Proof.
H: PropResizing
H0: Univalence
O: Ordinal
a: O
Isomorphism O ↓a -> Empty
  intros p % equiv_path_Ordinal.
H: PropResizing
H0: Univalence
O: Ordinal
a: O
p: O = ↓a
Empty
  enough (HO : O < O) by exact (irreflexive_ordinal_relation _ _ _ _ HO).
H: PropResizing
H0: Univalence
O: Ordinal
a: O
p: O = ↓a
O < O
  exists a.
H: PropResizing
H0: Univalence
O: Ordinal
a: O
p: O = ↓a
O = ↓a exact p.
Qed.

(** * Ordinal successor *)

Definition successor (A : Ordinal) : Ordinal.
A: Ordinal
Ordinal
Proof.
A: Ordinal
Ordinal
  set (carrier := (A + Unit)%type).
A: Ordinal
carrier:= (A + Unit)%type: Type
Ordinal
  set (relation (x y : carrier) :=
         match x, y with
         | inl x, inl y => x < y
         | inl x, inr _ => Unit
         | inr _, inl y => Empty
         | inr _, inr _ => Empty
         end).
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
Ordinal
  exists carrier relation.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
IsOrdinal carrier lt constructor.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
IsHSet carrier
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
is_mere_relation carrier lt
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
Extensional lt
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
WellFounded lt
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
Transitive lt
  -
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
IsHSet carrier exact _.
  -
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
is_mere_relation carrier lt intros [x | ?] [y | ?]; cbn; exact _.
  -
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
Extensional lt intros [x | []] [y | []] H.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
x, y: A
H: forall c : carrier, c < inl x <-> c < inl y
inl x = inl y
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
x: A
H: forall c : carrier, c < inl x <-> c < inr tt
inl x = inr tt
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
y: A
H: forall c : carrier, c < inr tt <-> c < inl y
inr tt = inl y
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
H: forall c : carrier, c < inr tt <-> c < inr tt
inr tt = inr tt
    +
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
x, y: A
H: forall c : carrier, c < inl x <-> c < inl y
inl x = inl y f_ap.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
x, y: A
H: forall c : carrier, c < inl x <-> c < inl y
x = y apply extensionality.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
x, y: A
H: forall c : carrier, c < inl x <-> c < inl y
forall c : A, c < x <-> c < y intros z.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
x, y: A
H: forall c : carrier, c < inl x <-> c < inl y
z: A
z < x <-> z < y exact (H (inl z)).
    +
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
x: A
H: forall c : carrier, c < inl x <-> c < inr tt
inl x = inr tt enough (H0 : relation (inl x) (inl x)).
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
x: A
H: forall c : carrier, c < inl x <-> c < inr tt
H0: relation (inl x) (inl x)
inl x = inr tt
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
x: A
H: forall c : carrier, c < inl x <-> c < inr tt
relation (inl x) (inl x) {
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
x: A
H: forall c : carrier, c < inl x <-> c < inr tt
H0: relation (inl x) (inl x)
inl x = inr tt
        cbn in H0.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
x: A
H: forall c : carrier, c < inl x <-> c < inr tt
H0: x < x
inl x = inr tt destruct (irreflexivity _ _ H0).
      }
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
x: A
H: forall c : carrier, c < inl x <-> c < inr tt
relation (inl x) (inl x)
      apply H.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
x: A
H: forall c : carrier, c < inl x <-> c < inr tt
inl x < inr tt cbn.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
x: A
H: forall c : carrier, c < inl x <-> c < inr tt
Unit exact tt.
    +
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
y: A
H: forall c : carrier, c < inr tt <-> c < inl y
inr tt = inl y enough (H0 : relation (inl y) (inl y)).
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
y: A
H: forall c : carrier, c < inr tt <-> c < inl y
H0: relation (inl y) (inl y)
inr tt = inl y
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
y: A
H: forall c : carrier, c < inr tt <-> c < inl y
relation (inl y) (inl y) {
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
y: A
H: forall c : carrier, c < inr tt <-> c < inl y
H0: relation (inl y) (inl y)
inr tt = inl y
        cbn in H0.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
y: A
H: forall c : carrier, c < inr tt <-> c < inl y
H0: y < y
inr tt = inl y destruct (irreflexivity _ _ H0).
      }
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
y: A
H: forall c : carrier, c < inr tt <-> c < inl y
relation (inl y) (inl y)
      apply H.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
y: A
H: forall c : carrier, c < inr tt <-> c < inl y
inl y < inr tt cbn.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
y: A
H: forall c : carrier, c < inr tt <-> c < inl y
Unit exact tt.
    +
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
H: forall c : carrier, c < inr tt <-> c < inr tt
inr tt = inr tt reflexivity.
  -
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
WellFounded lt assert (H : forall a, Accessible relation (inl a)).
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
forall a : A, Accessible relation (inl a)
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
H: forall a : A, Accessible relation (inl a)
WellFounded lt {
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
forall a : A, Accessible relation (inl a)
      intros a.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
a: A
Accessible relation (inl a) induction (well_foundedness a) as [a _ IH].
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
a: A
IH: forall b : A,
b < a -> Accessible relation (inl b)
Accessible relation (inl a)
      constructor; intros [b | []]; cbn; intros H.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
a: A
IH: forall b : A,
b < a -> Accessible relation (inl b)
b: A
H: b < a
Accessible relation (inl b)
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
a: A
IH: forall b : A,
b < a -> Accessible relation (inl b)
H: Empty
Accessible relation (inr tt)
      +
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
a: A
IH: forall b : A,
b < a -> Accessible relation (inl b)
b: A
H: b < a
Accessible relation (inl b) apply IH.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
a: A
IH: forall b : A,
b < a -> Accessible relation (inl b)
b: A
H: b < a
b < a exact H.
      +
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
a: A
IH: forall b : A,
b < a -> Accessible relation (inl b)
H: Empty
Accessible relation (inr tt) destruct H.
    }
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
H: forall a : A, Accessible relation (inl a)
WellFounded lt
    intros [x | []].
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
H: forall a : A, Accessible relation (inl a)
x: A
Accessible lt (inl x)
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
H: forall a : A, Accessible relation (inl a)
Accessible lt (inr tt)
    +
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
H: forall a : A, Accessible relation (inl a)
x: A
Accessible lt (inl x) apply H.
    +
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
H: forall a : A, Accessible relation (inl a)
Accessible lt (inr tt) constructor; intros [b | []]; cbn; intros H0.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
H: forall a : A, Accessible relation (inl a)
b: A
H0: Unit
Accessible lt (inl b)
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
H: forall a : A, Accessible relation (inl a)
H0: Empty
Accessible lt (inr tt)
      *
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
H: forall a : A, Accessible relation (inl a)
b: A
H0: Unit
Accessible lt (inl b) apply H.
      *
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
H: forall a : A, Accessible relation (inl a)
H0: Empty
Accessible lt (inr tt) destruct H0.
  -
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
Transitive lt intros [x | []] [y | []] [z | []]; cbn; auto.
A: Ordinal
carrier:= (A + Unit)%type: Type
relation:= fun x y : carrier =>
match x with
| inl x0 =>
    match y with
    | inl y0 => x0 < y0
    | inr _ => Unit
    end
| inr _ =>
    match y with
    | inl _ | _ => Empty
    end
end: carrier -> carrier -> Type
x, z: A
Unit -> Empty -> x < z
    intros _ [].
Defined.


Lemma lt_successor `{PropResizing} `{Univalence} (A : Ordinal)
  : A < successor A.
H: PropResizing
H0: Univalence
A: Ordinal
A < successor A
Proof.
H: PropResizing
H0: Univalence
A: Ordinal
A < successor A
  exists (inr tt).
H: PropResizing
H0: Univalence
A: Ordinal
A = ↓(inr tt)
  srapply path_Ordinal.
H: PropResizing
H0: Univalence
A: Ordinal
A <~> ↓(inr tt)
H: PropResizing
H0: Univalence
A: Ordinal
forall a a' : A, a < a' <-> ?f a < ?f a'
  -
H: PropResizing
H0: Univalence
A: Ordinal
A <~> ↓(inr tt) srapply equiv_adjointify.
H: PropResizing
H0: Univalence
A: Ordinal
A -> ↓(inr tt)
H: PropResizing
H0: Univalence
A: Ordinal
↓(inr tt) -> A
H: PropResizing
H0: Univalence
A: Ordinal
?f o ?g == idmap
H: PropResizing
H0: Univalence
A: Ordinal
?g o ?f == idmap
    +
H: PropResizing
H0: Univalence
A: Ordinal
A -> ↓(inr tt) intros a.
H: PropResizing
H0: Univalence
A: Ordinal
a: A
↓(inr tt) srapply in_.
H: PropResizing
H0: Univalence
A: Ordinal
a: A
successor A
H: PropResizing
H0: Univalence
A: Ordinal
a: A
?x < inr tt
      *
H: PropResizing
H0: Univalence
A: Ordinal
a: A
successor A exact (inl a).
      *
H: PropResizing
H0: Univalence
A: Ordinal
a: A
inl a < inr tt exact tt.
    +
H: PropResizing
H0: Univalence
A: Ordinal
↓(inr tt) -> A intros [[a | []] Ha]; cbn in *.
H: PropResizing
H0: Univalence
A: Ordinal
a: ordinal_carrier A
Ha: smalltype Unit
ordinal_carrier A
H: PropResizing
H0: Univalence
A: Ordinal
Ha: smalltype Empty
ordinal_carrier A
      *
H: PropResizing
H0: Univalence
A: Ordinal
a: ordinal_carrier A
Ha: smalltype Unit
ordinal_carrier A exact a.
      *
H: PropResizing
H0: Univalence
A: Ordinal
Ha: smalltype Empty
ordinal_carrier A apply equiv_smalltype in Ha.
H: PropResizing
H0: Univalence
A: Ordinal
Ha: Empty
ordinal_carrier A destruct Ha.
    +
H: PropResizing
H0: Univalence
A: Ordinal
(fun a : A => in_ (inl a) tt)
o (fun X : ↓(inr tt) =>
   (fun proj1 : successor A =>
    match
      proj1 as s return (smalltype (s < inr tt) -> A)
    with
    | inl t =>
        (fun (a : A) (_ : smalltype (inl a < inr tt))
         => a : A) t
    | inr u =>
        (fun u0 : Unit =>
         match
           u0 as u1
           return (smalltype (inr u1 < inr tt) -> A)
         with
         | tt =>
             fun Ha : smalltype (inr tt < inr tt) =>
             (let X0 :=
                fun (X0 : Type) (IsSmall : IsSmall X0)
                => equiv_fun (equiv_smalltype X0) in
              let Ha0 :=
                X0 Empty
                  (issmall_hprop Empty
                     (istrunc_S Empty (... => ...)))
                  Ha in
              match
                Ha0 return (ordinal_carrier A)
              with
              end)
             :
             A
         end) u
    end) X.1 X.2) == idmap intros [[a | []] Ha].
H: PropResizing
H0: Univalence
A: Ordinal
a: A
Ha: smalltype (inl a < inr tt)
in_ (inl a) tt = (inl a; Ha)
H: PropResizing
H0: Univalence
A: Ordinal
Ha: smalltype (inr tt < inr tt)
in_
  (inl
     (let X :=
        fun (X : Type) (IsSmall : IsSmall X) =>
        equiv_fun (equiv_smalltype X) in
      let Ha :=
        X Empty
          (issmall_hprop Empty
             (istrunc_S Empty
                (fun x y : Empty =>
                 match
                   x as e
                   return
                     (forall y0 : Empty,
                      Contr (e = y0))
                 with
                 end y))) Ha in
      match Ha return (ordinal_carrier A) with
      end)) tt = (inr tt; Ha)
      *
H: PropResizing
H0: Univalence
A: Ordinal
a: A
Ha: smalltype (inl a < inr tt)
in_ (inl a) tt = (inl a; Ha) unfold in_.
H: PropResizing
H0: Univalence
A: Ordinal
a: A
Ha: smalltype (inl a < inr tt)
(inl a; (equiv_smalltype (inl a < inr tt))^-1 tt) =
(inl a; Ha) cbn.
H: PropResizing
H0: Univalence
A: Ordinal
a: A
Ha: smalltype (inl a < inr tt)
(inl a; (equiv_smalltype Unit)^-1 tt) = (inl a; Ha) f_ap.
H: PropResizing
H0: Univalence
A: Ordinal
a: A
Ha: smalltype (inl a < inr tt)
(equiv_smalltype Unit)^-1 tt = Ha
        assert (IsHProp (smalltype Unit)) by exact _.
H: PropResizing
H0: Univalence
A: Ordinal
a: A
Ha: smalltype (inl a < inr tt)
X: IsHProp (smalltype Unit)
(equiv_smalltype Unit)^-1 tt = Ha
        apply path_ishprop.
      *
H: PropResizing
H0: Univalence
A: Ordinal
Ha: smalltype (inr tt < inr tt)
in_
  (inl
     (let X :=
        fun (X : Type) (IsSmall : IsSmall X) =>
        equiv_fun (equiv_smalltype X) in
      let Ha :=
        X Empty
          (issmall_hprop Empty
             (istrunc_S Empty
                (fun x y : Empty =>
                 match
                   x as e
                   return
                     (forall y0 : Empty,
                      Contr (e = y0))
                 with
                 end y))) Ha in
      match Ha return (ordinal_carrier A) with
      end)) tt = (inr tt; Ha) destruct (equiv_smalltype _ Ha).
    +
H: PropResizing
H0: Univalence
A: Ordinal
(fun X : ↓(inr tt) =>
 (fun proj1 : successor A =>
  match
    proj1 as s return (smalltype (s < inr tt) -> A)
  with
  | inl t =>
      (fun (a : A) (_ : smalltype (inl a < inr tt)) =>
       a : A) t
  | inr u =>
      (fun u0 : Unit =>
       match
         u0 as u1
         return (smalltype (inr u1 < inr tt) -> A)
       with
       | tt =>
           fun Ha : smalltype (inr tt < inr tt) =>
           (let X0 :=
              fun (X0 : Type) (IsSmall : IsSmall X0)
              => equiv_fun (equiv_smalltype X0) in
            let Ha0 :=
              X0 Empty
                (issmall_hprop Empty
                   (istrunc_S Empty (... => ...))) Ha
              in
            match Ha0 return (ordinal_carrier A) with
            end)
           :
           A
       end) u
  end) X.1 X.2) o (fun a : A => in_ (inl a) tt) ==
idmap intros a.
H: PropResizing
H0: Univalence
A: Ordinal
a: A
match
  (in_ (inl a) tt).1 as s
  return (smalltype (s < inr tt) -> A)
with
| inl t => fun _ : smalltype (inl t < inr tt) => t
| inr u =>
    match
      u as u0
      return (smalltype (inr u0 < inr tt) -> A)
    with
    | tt =>
        fun Ha : smalltype (inr tt < inr tt) =>
        let X :=
          fun (X : Type) (IsSmall : IsSmall X) =>
          equiv_fun (equiv_smalltype X) in
        let Ha0 :=
          X Empty
            (issmall_hprop Empty
               (istrunc_S Empty
                  (fun x y : Empty =>
                   match
                     x as e
                     return
                       (forall y0 : Empty,
                        Contr (e = y0))
                   with
                   end y))) Ha in
        match Ha0 return (ordinal_carrier A) with
        end
    end
end (in_ (inl a) tt).2 = a reflexivity.
  -
H: PropResizing
H0: Univalence
A: Ordinal
forall a a' : A,
a < a' <->
equiv_adjointify (fun a0 : A => in_ (inl a0) tt)
  (fun X : ↓(inr tt) =>
   (fun proj1 : successor A =>
    match
      proj1 as s return (smalltype (s < inr tt) -> A)
    with
    | inl t =>
        (fun (a0 : A)
           (_ : smalltype (inl a0 < inr tt)) => a0 : A)
          t
    | inr u =>
        (fun u0 : Unit =>
         match
           u0 as u1
           return (smalltype (inr u1 < inr tt) -> A)
         with
         | tt =>
             fun Ha : smalltype (inr tt < inr tt) =>
             (let X0 :=
                fun (X0 : Type) (IsSmall : IsSmall X0)
                => equiv_fun (equiv_smalltype X0) in
              let Ha0 :=
                X0 Empty
                  (issmall_hprop Empty
                     (istrunc_S Empty ...)) Ha in
              match
                Ha0 return (ordinal_carrier A)
              with
              end)
             :
             A
         end) u
    end) X.1 X.2)
  ((fun x : ↓(inr tt) =>
    (fun proj1 : successor A =>
     match
       proj1 as s
       return
         (forall proj2 : smalltype (s < inr tt),
          in_
            (inl
               (match s as s0 return ... with
                | inl t => fun ... => t
                | inr u =>
                    match ... with
                    | ... ...
                    end
                end proj2)) tt = (s; proj2))
     with
     | inl t =>
         (fun (a0 : A)
            (Ha : smalltype (inl a0 < inr tt)) =>
          (ap11 1
             (let X := istrunc_smalltype Unit (-1) in
              path_ishprop
                ((equiv_smalltype Unit)^-1 tt) Ha)
           :
           (inl a0;
           (equiv_smalltype (inl a0 < inr tt))^-1 tt) =
           (inl a0; Ha))
          :
          in_ (inl a0) tt = (inl a0; Ha)) t
     | inr u =>
         (fun u0 : Unit =>
          match
            u0 as u1
            return
              (forall
               proj2 : smalltype (inr u1 < inr tt),
               in_ (inl (...)) tt = (inr u1; proj2))
          with
          | tt =>
              fun Ha : smalltype (inr tt < inr tt) =>
              let l :=
                equiv_smalltype (inr tt < inr tt) Ha
                in
              match
                l return (in_ ... tt = (...; Ha))
              with
              end
          end) u
     end) x.1 x.2)
   :
   (fun a0 : A => in_ (inl a0) tt)
   o (fun X : ↓(inr tt) =>
      (fun proj1 : successor A =>
       match
         proj1 as s
         return (smalltype (s < inr tt) -> A)
       with
       | inl t =>
           (fun (a0 : A)
              (_ : smalltype (inl a0 < inr tt)) =>
            a0 : A) t
       | inr u =>
           (fun u0 : Unit =>
            match
              u0 as u1
              return (smalltype (... < ...) -> A)
            with
            | tt =>
                fun Ha : smalltype (inr tt < inr tt)
                =>
                (let X0 :=
                   fun ... ... => equiv_fun ... in
                 let Ha0 := X0 Empty ... Ha in
                 match ... with
                 end)
                :
                A
            end) u
       end) X.1 X.2) == idmap)
  ((fun a0 : A => 1%path)
   :
   (fun X : ↓(inr tt) =>
    (fun proj1 : successor A =>
     match
       proj1 as s return (smalltype (s < inr tt) -> A)
     with
     | inl t =>
         (fun (a0 : A)
            (_ : smalltype (inl a0 < inr tt)) =>
          a0 : A) t
     | inr u =>
         (fun u0 : Unit =>
          match
            u0 as u1
            return (smalltype (... < ...) -> A)
          with
          | tt =>
              fun Ha : smalltype (inr tt < inr tt) =>
              (let X0 := fun ... ... => equiv_fun ...
                 in
               let Ha0 := X0 Empty ... Ha in
               match ... with
               end)
              :
              A
          end) u
     end) X.1 X.2) o (fun a0 : A => in_ (inl a0) tt) ==
   idmap) a <
equiv_adjointify (fun a0 : A => in_ (inl a0) tt)
  (fun X : ↓(inr tt) =>
   (fun proj1 : successor A =>
    match
      proj1 as s return (smalltype (s < inr tt) -> A)
    with
    | inl t =>
        (fun (a0 : A)
           (_ : smalltype (inl a0 < inr tt)) => a0 : A)
          t
    | inr u =>
        (fun u0 : Unit =>
         match
           u0 as u1
           return (smalltype (inr u1 < inr tt) -> A)
         with
         | tt =>
             fun Ha : smalltype (inr tt < inr tt) =>
             (let X0 :=
                fun (X0 : Type) (IsSmall : IsSmall X0)
                => equiv_fun (equiv_smalltype X0) in
              let Ha0 :=
                X0 Empty
                  (issmall_hprop Empty
                     (istrunc_S Empty ...)) Ha in
              match
                Ha0 return (ordinal_carrier A)
              with
              end)
             :
             A
         end) u
    end) X.1 X.2)
  ((fun x : ↓(inr tt) =>
    (fun proj1 : successor A =>
     match
       proj1 as s
       return
         (forall proj2 : smalltype (s < inr tt),
          in_
            (inl
               (match s as s0 return ... with
                | inl t => fun ... => t
                | inr u =>
                    match ... with
                    | ... ...
                    end
                end proj2)) tt = (s; proj2))
     with
     | inl t =>
         (fun (a0 : A)
            (Ha : smalltype (inl a0 < inr tt)) =>
          (ap11 1
             (let X := istrunc_smalltype Unit (-1) in
              path_ishprop
                ((equiv_smalltype Unit)^-1 tt) Ha)
           :
           (inl a0;
           (equiv_smalltype (inl a0 < inr tt))^-1 tt) =
           (inl a0; Ha))
          :
          in_ (inl a0) tt = (inl a0; Ha)) t
     | inr u =>
         (fun u0 : Unit =>
          match
            u0 as u1
            return
              (forall
               proj2 : smalltype (inr u1 < inr tt),
               in_ (inl (...)) tt = (inr u1; proj2))
          with
          | tt =>
              fun Ha : smalltype (inr tt < inr tt) =>
              let l :=
                equiv_smalltype (inr tt < inr tt) Ha
                in
              match
                l return (in_ ... tt = (...; Ha))
              with
              end
          end) u
     end) x.1 x.2)
   :
   (fun a0 : A => in_ (inl a0) tt)
   o (fun X : ↓(inr tt) =>
      (fun proj1 : successor A =>
       match
         proj1 as s
         return (smalltype (s < inr tt) -> A)
       with
       | inl t =>
           (fun (a0 : A)
              (_ : smalltype (inl a0 < inr tt)) =>
            a0 : A) t
       | inr u =>
           (fun u0 : Unit =>
            match
              u0 as u1
              return (smalltype (... < ...) -> A)
            with
            | tt =>
                fun Ha : smalltype (inr tt < inr tt)
                =>
                (let X0 :=
                   fun ... ... => equiv_fun ... in
                 let Ha0 := X0 Empty ... Ha in
                 match ... with
                 end)
                :
                A
            end) u
       end) X.1 X.2) == idmap)
  ((fun a0 : A => 1%path)
   :
   (fun X : ↓(inr tt) =>
    (fun proj1 : successor A =>
     match
       proj1 as s return (smalltype (s < inr tt) -> A)
     with
     | inl t =>
         (fun (a0 : A)
            (_ : smalltype (inl a0 < inr tt)) =>
          a0 : A) t
     | inr u =>
         (fun u0 : Unit =>
          match
            u0 as u1
            return (smalltype (... < ...) -> A)
          with
          | tt =>
              fun Ha : smalltype (inr tt < inr tt) =>
              (let X0 := fun ... ... => equiv_fun ...
                 in
               let Ha0 := X0 Empty ... Ha in
               match ... with
               end)
              :
              A
          end) u
     end) X.1 X.2) o (fun a0 : A => in_ (inl a0) tt) ==
   idmap) a' cbn.
H: PropResizing
H0: Univalence
A: Ordinal
forall a a' : ordinal_carrier A, a < a' <-> a < a' intros a a'.
H: PropResizing
H0: Univalence
A: Ordinal
a, a': ordinal_carrier A
a < a' <-> a < a' reflexivity.
Qed.

(** * Ordinal limit *)

Section Image.

  Universes i j.
  (** In the following, there are no constraints between [i] and [j]. *)
  Context `{PropResizing} `{Funext} {A : Type@{i}} {B : HSet@{j}} (f : A -> B).

  Local Definition qkfs := quotient_kernel_factor_small f.
  Local Definition image : Type@{i} := qkfs.1.
  Local Definition factor1 : A -> image := qkfs.2.1.
  Local Definition factor2 : image -> B := qkfs.2.2.1.
  Local Definition isinjective_factor2 : IsInjective factor2
    := isinj_embedding _ (snd (fst qkfs.2.2.2)).
  Local Definition image_ind_prop (P : image -> Type@{k}) `{forall x, IsHProp (P x)}
    (step : forall a : A, P (factor1 a))
    : forall x : image, P x
    := Quotient_ind_hprop _ P step.
  (** [factor2 o factor1 == f] is definitional, so we don't state that. *)

End Image.

Definition limit `{Univalence} `{PropResizing}
           {X : Type} (F : X -> Ordinal) : Ordinal.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
Ordinal
Proof.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
Ordinal
  set (f := fun x : {i : X & F i} => ↓x.2).
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
Ordinal
  set (carrier := image f : Type@{i}).
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
Ordinal
  set (relation := fun A B : carrier =>
                     smalltype (factor2 f A < factor2 f B)
                     : Type@{i}).
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
Ordinal
  exists carrier relation.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
IsOrdinal carrier lt
  snapply (isordinal_simulation (factor2 f)).
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
IsHSet (image f)
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
is_mere_relation (image f) lt
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
Lt (default_TruncType 0 Ordinal ishset_Ordinal)
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
IsOrdinal (default_TruncType 0 Ordinal ishset_Ordinal)
  ?Q
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
IsInjective (factor2 f)
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
IsSimulation (factor2 f)
  1-4: exact _.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
IsInjective (factor2 f)
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
IsSimulation (factor2 f)
  -
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
IsInjective (factor2 f) apply isinjective_factor2.
  -
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
IsSimulation (factor2 f) constructor.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
forall a a' : image f,
a < a' -> factor2 f a < factor2 f a'
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
forall (a : image f)
(b : default_TruncType 0 Ordinal ishset_Ordinal),
b < factor2 f a ->
hexists
  (fun a' : image f =>
   ((a' < a) * (factor2 f a' = b))%type)
    +
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
forall a a' : image f,
a < a' -> factor2 f a < factor2 f a' intros x x' x_x'.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
x, x': image f
x_x': x < x'
factor2 f x < factor2 f x'
      unfold lt, relation.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
x, x': image f
x_x': x < x'
lt_Ordinal (factor2 f x) (factor2 f x') apply equiv_smalltype in x_x'.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
x, x': image f
x_x': factor2 f x < factor2 f x'
lt_Ordinal (factor2 f x) (factor2 f x') exact x_x'.
    +
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
forall (a : image f)
(b : default_TruncType 0 Ordinal ishset_Ordinal),
b < factor2 f a ->
hexists
  (fun a' : image f =>
   ((a' < a) * (factor2 f a' = b))%type) nrefine (image_ind_prop f _ _).
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
forall x : image f,
IsHProp
  (forall
   b : default_TruncType 0 Ordinal ishset_Ordinal,
   b < factor2 f x ->
   hexists
     (fun a' : image f =>
      ((a' < x) * (factor2 f a' = b))%type))
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
forall (a : {i : X & F i})
(b : default_TruncType 0 Ordinal ishset_Ordinal),
b < factor2 f (factor1 f a) ->
hexists
  (fun a' : image f =>
   ((a' < factor1 f a) * (factor2 f a' = b))%type) 1: exact _.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
forall (a : {i : X & F i})
(b : default_TruncType 0 Ordinal ishset_Ordinal),
b < factor2 f (factor1 f a) ->
hexists
  (fun a' : image f =>
   ((a' < factor1 f a) * (factor2 f a' = b))%type)
      intros a.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
forall b : default_TruncType 0 Ordinal ishset_Ordinal,
b < factor2 f (factor1 f a) ->
hexists
  (fun a' : image f =>
   ((a' < factor1 f a) * (factor2 f a' = b))%type)
      change (factor2 f (class_of _ a)) with (f a).
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
forall b : default_TruncType 0 Ordinal ishset_Ordinal,
b < factor2 f (factor1 f a) ->
hexists
  (fun a' : image f =>
   ((a' < factor1 f a) * (factor2 f a' = b))%type)
      intros B B_fa.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
hexists
  (fun a' : image f =>
   ((a' < factor1 f a) * (factor2 f a' = B))%type) apply tr.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
{a' : image f &
((a' < factor1 f a) * (factor2 f a' = B))%type}
      exists (factor1 f (a.1; out (bound B_fa))).
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
((factor1 f (a.1; out ((H0 ◁ B) B_fa)) < factor1 f a) *
 (factor2 f (factor1 f (a.1; out ((H0 ◁ B) B_fa))) = B))%type
      unfold lt, relation.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
(smalltype
   (factor2 f (factor1 f (a.1; out ((H0 ◁ B) B_fa))) <
    factor2 f (factor1 f a)) *
 (factor2 f (factor1 f (a.1; out ((H0 ◁ B) B_fa))) = B))%type
      change (factor2 f (factor1 f ?A)) with (f A).
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
(smalltype (f (a.1; out ((H0 ◁ B) B_fa)) < f a) *
 (f (a.1; out ((H0 ◁ B) B_fa)) = B))%type
      unfold f.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
(smalltype (↓(a.1; out ((H0 ◁ B) B_fa)).2 < ↓a.2) *
 (↓(a.1; out ((H0 ◁ B) B_fa)).2 = B))%type
      assert (↓(out (bound B_fa)) = B) as ->.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
↓(out ((H0 ◁ B) B_fa)) = B
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
(smalltype (B < ↓a.2) * (B = B))%type {
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
↓(out ((H0 ◁ B) B_fa)) = B
        rewrite (path_initial_segment_simulation out).
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
↓((H0 ◁ B) B_fa) = B
        symmetry.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
B = ↓((H0 ◁ B) B_fa) apply bound_property.
      }
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
(smalltype (B < ↓a.2) * (B = B))%type
      split.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
smalltype (B < ↓a.2)
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
B = B
      *
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
smalltype (B < ↓a.2) apply equiv_smalltype.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
B < ↓a.2 exact B_fa.
      *
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
carrier:= image f : Type: Type
relation:= fun A B : carrier =>
smalltype (factor2 f A < factor2 f B) : Type: carrier -> carrier -> Type
a: {i : X & F i}
B: default_TruncType 0 Ordinal ishset_Ordinal
B_fa: B < factor2 f (factor1 f a)
B = B reflexivity.
Defined.

Instance le_on_Ordinal : Le Ordinal :=
  fun A B => exists f : A -> B, IsSimulation f.

Definition limit_is_upper_bound `{Univalence} `{PropResizing}
           {X : Type} (F : X -> Ordinal)
  : forall x, F x <= limit F.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
forall x : X, F x ≤ limit F
Proof.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
forall x : X, F x ≤ limit F
  set (f := fun x : {i : X & F i} => ↓x.2).
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
forall x : X, F x ≤ limit F
  intros x.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
F x ≤ limit F unfold le, le_on_Ordinal.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
{f : F x -> limit F & IsSimulation f}
  exists (fun u => factor1 f (x; u)).
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
IsSimulation (fun u : F x => factor1 f (x; u))
  split.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
forall a a' : F x,
a < a' -> factor1 f (x; a) < factor1 f (x; a')
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
forall (a : F x) (b : limit F),
b < factor1 f (x; a) ->
hexists
  (fun a' : F x =>
   ((a' < a) * (factor1 f (x; a') = b))%type)
  -
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
forall a a' : F x,
a < a' -> factor1 f (x; a) < factor1 f (x; a') intros u v u_v.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u, v: F x
u_v: u < v
factor1 f (x; u) < factor1 f (x; v)
    change (smalltype (f (x; u) < f (x; v))).
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u, v: F x
u_v: u < v
smalltype (f (x; u) < f (x; v))
    apply equiv_smalltype.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u, v: F x
u_v: u < v
f (x; u) < f (x; v)
    apply isembedding_initial_segment.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u, v: F x
u_v: u < v
(x; u).2 < (x; v).2 exact u_v.
  -
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
forall (a : F x) (b : limit F),
b < factor1 f (x; a) ->
hexists
  (fun a' : F x =>
   ((a' < a) * (factor1 f (x; a') = b))%type) intros u.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
forall b : limit F,
b < factor1 f (x; u) ->
hexists
  (fun a' : F x =>
   ((a' < u) * (factor1 f (x; a') = b))%type)
    nrefine (image_ind_prop f _ _).
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
forall x0 : image f,
IsHProp
  (x0 < factor1 f (x; u) ->
   hexists
     (fun a' : F x =>
      ((a' < u) * (factor1 f (x; a') = x0))%type))
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
forall a : {i : X & F i},
factor1 f a < factor1 f (x; u) ->
hexists
  (fun a' : F x =>
   ((a' < u) * (factor1 f (x; a') = factor1 f a))%type) 1: exact _.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
forall a : {i : X & F i},
factor1 f a < factor1 f (x; u) ->
hexists
  (fun a' : F x =>
   ((a' < u) * (factor1 f (x; a') = factor1 f a))%type)
    intros a a_u.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
a: {i : X & F i}
a_u: factor1 f a < factor1 f (x; u)
hexists
  (fun a' : F x =>
   ((a' < u) * (factor1 f (x; a') = factor1 f a))%type)
    change (smalltype (f a < f (x; u))) in a_u.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
a: {i : X & F i}
a_u: smalltype (f a < f (x; u))
hexists
  (fun a' : F x =>
   ((a' < u) * (factor1 f (x; a') = factor1 f a))%type)
    apply equiv_smalltype in a_u.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
a: {i : X & F i}
a_u: f a < f (x; u)
hexists
  (fun a' : F x =>
   ((a' < u) * (factor1 f (x; a') = factor1 f a))%type)
    apply tr.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
a: {i : X & F i}
a_u: f a < f (x; u)
{a' : F x &
((a' < u) * (factor1 f (x; a') = factor1 f a))%type} exists (out (bound a_u)).
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
a: {i : X & F i}
a_u: f a < f (x; u)
((out ((H0 ◁ f a) a_u) < u) *
 (factor1 f (x; out ((H0 ◁ f a) a_u)) = factor1 f a))%type split.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
a: {i : X & F i}
a_u: f a < f (x; u)
out ((H0 ◁ f a) a_u) < u
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
a: {i : X & F i}
a_u: f a < f (x; u)
factor1 f (x; out ((H0 ◁ f a) a_u)) = factor1 f a
    +
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
a: {i : X & F i}
a_u: f a < f (x; u)
out ((H0 ◁ f a) a_u) < u apply initial_segment_property.
    +
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
a: {i : X & F i}
a_u: f a < f (x; u)
factor1 f (x; out ((H0 ◁ f a) a_u)) = factor1 f a apply (isinjective_factor2 f); simpl.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
a: {i : X & F i}
a_u: f a < f (x; u)
factor2 f (factor1 f (x; out ((H0 ◁ f a) a_u))) =
factor2 f (factor1 f a)
      change (factor2 f (factor1 f ?A)) with (f A).
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
a: {i : X & F i}
a_u: f a < f (x; u)
f (x; out ((H0 ◁ f a) a_u)) = f a
      unfold f.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
a: {i : X & F i}
a_u: f a < f (x; u)
↓(x; out ((H0 ◁ ↓a.2) a_u)).2 = ↓a.2
      rewrite (path_initial_segment_simulation out).
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
a: {i : X & F i}
a_u: f a < f (x; u)
↓((H0 ◁ ↓a.2) a_u) = ↓a.2
      symmetry.
H: Univalence
H0: PropResizing
X: Type
F: X -> Ordinal
f:= fun x : {i : X & F i} => ↓x.2: {i : X & F i} -> Ordinal
x: X
u: F x
a: {i : X & F i}
a_u: f a < f (x; u)
↓a.2 = ↓((H0 ◁ ↓a.2) a_u) apply bound_property.
Qed.

(** Any type equivalent to an ordinal is an ordinal, and we can change the universe that the relation takes values in. *)

(* TODO: Should factor this into two results:  (1) Anything equivalent to an ordinal is an ordinal (with the relation landing in the same universe for both).  (2) Under PropResizing, the universe that the relation takes values in can be changed. *)
Definition resize_ordinal@{i j +} `{PropResizing} (B : Ordinal@{i _}) (C : Type@{j}) (g : C <~> B)
  : Ordinal@{j _}.
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
Ordinal
Proof.
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
Ordinal
  exists C (fun c1 c2 : C => smalltype (g c1 < g c2)).
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
IsOrdinal C lt
  snapply (isordinal_simulation g); only 2, 3, 4, 5: exact _.
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
IsHSet C
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
IsSimulation g
  -
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
IsHSet C exact (istrunc_equiv_istrunc B (equiv_inverse g)).
  -
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
IsSimulation g constructor.
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
forall a a' : C, a < a' -> g a < g a'
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
forall (a : C) (b : B),
b < g a ->
hexists (fun a' : C => ((a' < a) * (g a' = b))%type)
    +
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
forall a a' : C, a < a' -> g a < g a' intros a a' a_a'.
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
a, a': C
a_a': a < a'
g a < g a' apply (equiv_smalltype _).
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
a, a': C
a_a': a < a'
smalltype (g a < g a') exact a_a'.
    +
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
forall (a : C) (b : B),
b < g a ->
hexists (fun a' : C => ((a' < a) * (g a' = b))%type) intros a b b_fa.
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
a: C
b: B
b_fa: b < g a
hexists (fun a' : C => ((a' < a) * (g a' = b))%type) apply tr.
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
a: C
b: B
b_fa: b < g a
{a' : C & ((a' < a) * (g a' = b))%type} exists (g^-1 b).
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
a: C
b: B
b_fa: b < g a
((g^-1 b < a) * (g (g^-1 b) = b))%type split.
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
a: C
b: B
b_fa: b < g a
g^-1 b < a
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
a: C
b: B
b_fa: b < g a
g (g^-1 b) = b
      *
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
a: C
b: B
b_fa: b < g a
g^-1 b < a apply equiv_smalltype.
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
a: C
b: B
b_fa: b < g a
g (g^-1 b) < g a rewrite eisretr.
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
a: C
b: B
b_fa: b < g a
b < g a exact b_fa.
      *
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
a: C
b: B
b_fa: b < g a
g (g^-1 b) = b apply eisretr.
Defined.

Lemma resize_ordinal_iso@{i j +} `{PropResizing} (B : Ordinal@{i _}) (C : Type@{j}) (g : C <~> B)
  : Isomorphism (resize_ordinal B C g) B.
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
Isomorphism (resize_ordinal B C g) B
Proof.
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
Isomorphism (resize_ordinal B C g) B
  exists g.
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
forall a a' : (resize_ordinal B C g).1,
(resize_ordinal B C g).2 a a' <-> B.2 (g a) (g a') intros a a'.
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
a, a': (resize_ordinal B C g).1
(resize_ordinal B C g).2 a a' <-> B.2 (g a) (g a') cbn.
H: PropResizing
B: Ordinal
C: Type
g: C <~> B
a, a': (resize_ordinal B C g).1
smalltype (g a < g a') <-> g a < g a' split; apply equiv_smalltype.
Qed.