Require Export cat.

Set Implicit Arguments.
Unset Strict Implicit.

Module Uple.

Export Universe.



(** An uple is a list indexed by natural numbers, which we
view as a function whose domain is a natural number.
The domain is the length, and the valid indices are all
those which are strictly less than the length (starting with [0]).
*)


Definition axioms a :=
Function.axioms a &
inc (domain a) nat.

Definition length a := Bnat (domain a).

Definition create (f:nat -> E) (l:nat) :=
Function.create (R l) (fun x => f (Bnat x)).

Lemma domain_create : forall f l, domain (create f l) = R l.
Proof.
ir. 
uf create. 
rw Function.create_domain. tv. 
Qed.

Lemma length_create : forall f l, length (create f l) = l.
Proof.
ir. uf length. rw domain_create. rww Bnat_R. 
Qed.

Definition component (i:nat) a :=
V (R i) a.


Lemma component_create : forall f l i,
i < l -> component i (create f l) = f i.
Proof.
ir. uf component. wri inc_lt H. 
uf create. rw create_V_rewrite. 
rw Bnat_R. tv. am. 
Qed. 

Lemma create_axioms : forall f l, axioms (create f l).
Proof.
ir. uhg; ee. 
uf create. ap Function.create_axioms. 
rw domain_create. ap R_inc. 
Qed.

Lemma eq_create : forall a, axioms a ->
a = create (fun i => component i a) (length a).
Proof.
ir. 
cp H. uh H; ee. 
cp (Function.create_recovers H). 
transitivity (Function.create (domain a) (fun x : E => V x a)).
sy; am. uf create. 
uf length. rw R_Bnat. 
ap Function.create_extensionality. tv. ir. 
uf component. rw R_Bnat. tv. 
assert (sub (domain a) nat). 
assert (domain a = R (B H1)). rww B_eq. 
rw H5. ap sub_R_nat. app H5. am. 
Qed.

Lemma compare_create : forall f g l m,
l = m -> (forall i, Peano.lt i l -> f i = g i) ->
create f l = create g m.
Proof.
ir. wr H. uf create. 
ap Function.create_extensionality. tv. 
ir. ap H0. wr inc_lt. rww R_Bnat. 
ap inc_nat_from_inc_R. sh l. am. 
Qed. 

Lemma domain_emptyset : domain emptyset = emptyset.
Proof. 
uf domain;
ap extensionality; uhg; ir. 
rwi Image.inc_rw H. nin H. ee. 
nin H. elim x1. 
nin H. elim x0. 
Qed. 

Lemma empty_axioms : axioms emptyset.
Proof.
ir. uhg; ee. 
set (k:= Function.identity emptyset). 
apply sub_axioms with k. uf k. ap Function.identity_axioms. 
uhg; ir. nin H. elim x0. 
rw domain_emptyset. 
wr nat_zero_emptyset. ap R_inc. 
Qed.

Lemma length_emptyset : length emptyset = 0.
Proof.
uf length. rw domain_emptyset. 
wr nat_zero_emptyset. rw Bnat_R. tv. 
Qed.

Lemma create_length_zero : forall f ,
create f 0 = emptyset.
Proof.
ir. cp (eq_create empty_axioms). 
rw H. ap compare_create. rww length_emptyset. 
ir. cp lt_n_O. elim (H1 i H0). 
Qed. 



Lemma uple_extensionality : forall a b,
axioms a -> axioms b -> 
length a = length b ->
(forall i, i < (length a) -> component i a = component i b) ->
a=b.
Proof.
ir. cp (eq_create H). cp (eq_create H0). 
rw H3; rw H4. ap compare_create. am. am. 
Qed.


Definition concatenate a b :=
create (fun i => 
Y (i < (length a)) (component i a) 
(component (i - (length a)) b))
((length a) + (length b)).

Lemma length_concatenate : forall a b,
length (concatenate a b) = (length a) + (length b).
Proof.
ir. uf concatenate. rww length_create. 
Qed.

Lemma concatenate_axioms : forall a b,
axioms (concatenate a b).
Proof.
ir. uf concatenate. ap create_axioms. 
Qed. 

Lemma component_concatenate_first : forall a b i,
i < (length a) -> component i (concatenate a b) = component i a.
Proof.
ir. uf concatenate. 
rw component_create. 
rw Y_if_rw. tv. am. 
auto with arith. 
Qed.

Lemma component_concatenate_second : forall a b i,
i < (plus (length a) (length b)) ->
(length a) <= i ->
component i (concatenate a b) = component (i - (length a)) b.
Proof.
ir. uf concatenate. rw component_create. 
rw Y_if_not_rw. tv. auto with arith. am. 
Qed.

Lemma component_concatenate_plus : forall a b i,
i < (length b) -> 
component ((length a) + i ) (concatenate a b) = component i b.
Proof.
ir. rw component_concatenate_second. 
rw minus_plus. tv. 
assert (i+length a = length a + i). auto with arith. 
auto with arith. auto with arith. 
Qed.

Lemma concatenate_emptyset_left : forall a,
axioms a -> 
concatenate emptyset a = a.
Proof.
ir. ap uple_extensionality. 
ap concatenate_axioms. am. 
rw length_concatenate. rw length_emptyset. 
auto with arith. 

ir. rw component_concatenate_second. rw length_emptyset. 
assert (i- 0 = i). auto with arith. rww H1. 
rwi length_concatenate H0. am. 
rw length_emptyset. auto with arith. 
Qed.

Lemma concatenate_emptyset_right : forall a,
axioms a ->
concatenate a emptyset = a.
Proof.
ir. ap uple_extensionality. ap concatenate_axioms. 
am. rw length_concatenate. rw length_emptyset. 
auto with arith. 
ir. rw component_concatenate_first. tv. 
rwi length_concatenate H0. rwi length_emptyset H0. 
assert (length a + 0 = length a). auto with arith. 
wrr H1. 
Qed.





Lemma concatenate_assoc : forall a b c,
concatenate a (concatenate b c) = 
concatenate (concatenate a b) c.
Proof.
ir. ap uple_extensionality. 
ap concatenate_axioms. ap concatenate_axioms. 
rw length_concatenate. 
rw length_concatenate. 
rw length_concatenate. 
rw length_concatenate. 
auto with arith. 

ir. apply by_cases with (i < length a + length b); ir.
apply by_cases with (i<length a); ir. 
rw component_concatenate_first. rw component_concatenate_first. 
rw component_concatenate_first. tv. am. 
rww length_concatenate. am. 
assert (length a <= i). 
nin (le_or_lt (length a) i). tv. 
elim (H1 H2). 
rw component_concatenate_second. rw component_concatenate_first. 
rw component_concatenate_first. rw component_concatenate_second. 
tv. am. am. rww length_concatenate. 
om. 

rw length_concatenate. rw plus_assoc. 
auto with arith. am. 
assert (length a + length b <= i). om. 
rwi length_concatenate H.
rwi length_concatenate H. 
rw component_concatenate_second. 
rw component_concatenate_second. 
rw component_concatenate_second. 
rw length_concatenate. 
assert (i - length a - length b = i - (length a + length b)).
om. rw H2. tv. 
rw length_concatenate. om. 
rw length_concatenate. om. 
om. om. 
rw length_concatenate. om. 
om. 
Qed. 

Definition uple1 x :=
create (fun i:nat => x) 1.

Lemma uple1_axioms : forall x, 
axioms (uple1 x). 
Proof.
ir. uf uple1. ap create_axioms. 
Qed.

Lemma length_uple1 : forall x, length (uple1 x) = 1.
Proof.
ir. uf uple1. rww length_create. 
Qed. 

Lemma component_uple1 : forall x i, 
i < 1 -> component i (uple1 x) = x.
Proof.
ir. uf uple1. 
rw component_create. tv. am. 
Qed. 

Lemma eq_uple1 : forall a x,
axioms a -> length a = 1 -> x = component 0 a -> 
a = uple1 x.
Proof.
ir. rw H1. ap uple_extensionality. 
am. ap uple1_axioms. 
rw length_uple1. am. 
ir. rw component_uple1. assert (i=0).
om. rww H3. om. 
Qed. 

Definition utack x a :=
concatenate a (uple1 x).

Lemma utack_axioms : forall a x,
axioms a -> axioms (utack x a).
Proof.
ir. uf utack. ap concatenate_axioms. 
Qed.

Lemma length_utack : forall a x,
axioms a -> length (utack x a) = (length a) + 1.
Proof.
ir. uf utack. rw length_concatenate. 
rww length_uple1. 
Qed.

Lemma domain_R_length : forall a,
axioms a -> domain a = R (length a).
Proof.
ir. uf length. rw R_Bnat. tv. 
uh H; ee. am. 
Qed. 

Lemma inc_R_domain : forall a i,
axioms  a -> 
inc (R i) (domain a) = (i < (length a)).
Proof.
ir. 
rw domain_R_length. 
rw inc_lt. tv. am. 
Qed.

Lemma component_utack_old : forall a x i,
axioms a -> i < (length a) -> 
component i (utack x a) = component i a.
Proof.
ir. uf utack. 
rw component_concatenate_first. tv. am. 
Qed.

Lemma component_utack_new : forall a x i,
axioms a -> i = length a ->
component i (utack x a) = x.
Proof.
ir. uf utack. rw component_concatenate_second. 
rw H0. 
rw component_uple1. tv. 
wr minus_n_n. auto with arith. 
rw length_uple1. rw H0. 
assert (length a + 1 = S (length a)). 
rw plus_comm. auto with arith. rw H1. 
ap lt_n_Sn. rw H0. auto with arith. 
Qed.

Definition restrict a i :=
create (fun j => component j a) i.

Lemma length_restrict : forall a i,
length (restrict a i) = i.
Proof.
ir. uf restrict. 
rw length_create. tv. 
Qed.

Lemma component_restrict : forall a i j,
j < i -> component j (restrict a i) = component j a.
Proof.
ir. uf restrict. 
rw component_create. tv. am. 
Qed.

Lemma restrict_axioms : forall a i,
axioms (restrict a i).
Proof. 
ir. uf restrict. 
ap create_axioms. 
Qed.

Lemma eq_utack_restrict : forall a,
axioms a -> length a > 0 -> 
a = utack (component (length a - 1) a) (restrict a (length a -1)).
Proof.
ir. 
ap uple_extensionality. 
am. ap utack_axioms. ap restrict_axioms. 
rw length_utack. rw length_restrict. om. 
ap restrict_axioms. 

ir. 
assert (i = length a - 1 \/ i < length a -1).
om. nin H2. 
rw H2. rw component_utack_new. tv. 
ap restrict_axioms. 
rw length_restrict. tv. 
rw component_utack_old. rw component_restrict. 
tv. am. ap restrict_axioms. rw length_restrict. am. 
Qed. 


Definition uple_map (f:E ->E) u :=
Uple.create  (fun i => f (component i u)) (length u).

Lemma length_uple_map : forall f u,
length (uple_map f u) = length u.
Proof.
ir. uf uple_map. rw length_create. tv. 
Qed.

Lemma component_uple_map : forall f u i,
i < length u -> component i (uple_map f u) = f (component i u).
Proof.
ir. 
uf uple_map. rw component_create. tv. am. 
Qed. 

Lemma axioms_uple_map : forall f u, axioms (uple_map f u).
Proof.
ir. uf uple_map. ap create_axioms. 
Qed. 


Lemma uple_map_uple1 : forall f u,
uple_map f (uple1 u) = uple1 (f u).
Proof.
ir. ap uple_extensionality. 
ap axioms_uple_map. ap uple1_axioms. 
rww length_uple_map. rw length_uple1. 
rww length_uple1. 
ir. rwi length_uple_map H. 
rwi length_uple1 H. assert (i=0). om. 
rw H0. rw component_uple_map. 
rw component_uple1. rw component_uple1. tv. om. om. 
rw length_uple1. om. 
Qed. 

Lemma uple_map_emptyset : forall f,
uple_map f emptyset = emptyset.
Proof.
ir. ap uple_extensionality. 
ap axioms_uple_map. 
ap Uple.empty_axioms. rww length_uple_map. 
ir. rwi length_uple_map H. 
rwi length_emptyset H. assert (0=1).
om. discriminate H0. 
Qed. 

Lemma uple_map_concatenate : forall f u v,
uple_map f (concatenate u v) = concatenate (uple_map f u)
(uple_map f v).
Proof.
ir. ap uple_extensionality. 
ap axioms_uple_map. 
ap concatenate_axioms. rw length_uple_map. 
rw length_concatenate. rw length_concatenate. 
rw length_uple_map. rw length_uple_map. tv. 

ir. rwi length_uple_map H. rwi length_concatenate H. 
rw component_uple_map. assert (i < length u \/ 
length u <= i). om. nin H0. 
rw component_concatenate_first. rw component_concatenate_first.
rw component_uple_map. tv. am. rw length_uple_map. am. 
am. rw component_concatenate_second. rw component_concatenate_second. 
rw length_uple_map. 
rw component_uple_map. tv. om. 
rw length_uple_map. rw length_uple_map. am. rw length_uple_map.
am. am. am. rw length_concatenate. am. 
Qed. 

End Uple.

Module Graph.
Export Uple. 

Definition Vertices   := R (v_(r_(t_ DOT ))).
Definition Edges := R (e_(d_(g_ DOT))).

Definition vertices a := V Vertices a.
Definition edges a := V Edges a.

Definition create v e :=
denote Vertices v 
(denote Edges e stop).

Definition like a := a = create  (vertices a) (edges a).

Lemma vertices_create : forall v e, vertices (create v e) =v.
Proof.
ir; uf vertices; uf create. drw. 
Qed.

Lemma edges_create : forall v e, edges (create v e) = e.
Proof.
ir; uf edges; uf create. drw. 
Qed. 



Lemma create_like : forall v e, like (create v e).
Proof.
ir. uf like. 
rw vertices_create. rw edges_create. tv. 
Qed.

Lemma like_extensionality : forall a b,
like a -> like b -> vertices a = vertices b ->
edges a = edges b -> a = b.
Proof.
ir. uh H; uh H0. 
rw H ; rw H0. 
rw H1; rw H2. tv. 
Qed. 

Definition axioms a :=
like a &
(forall u, inc u (edges a) -> Arrow.like u) &
(forall u, inc u (edges a) -> inc (source u) (vertices a)) &
(forall u, inc u (edges a) -> inc (target u) (vertices a)).

Lemma axioms_extensionality : forall a b,
axioms a -> axioms b -> vertices a = vertices b ->
edges a = edges b -> a = b.
Proof.
ir. uh H; uh H0. ee. app like_extensionality. 
Qed. 


End Graph.

Module Free_Category.
Export Graph.
Export Iterate.

(** Now we define the free category on a graph. ***)

Definition segment (i:nat) u :=
component i (arrow u).

Definition seg_length u :=
length (arrow u).

Definition arrow_chain u :=
Arrow.like u &
Uple.axioms (arrow u) &
(0 < seg_length u -> source (segment 0 u) = source u) &
(0 < seg_length u -> 
target (segment (seg_length u -1) u) = target u) &
(forall i, i+1 < seg_length u ->
source (segment (i+1) u) = 
target (segment i u)) &
(seg_length u = 0 -> source u = target u).

Definition mor_freecat a u :=
axioms a & 
inc (source u) (vertices a) &
inc (target u) (vertices a) &
arrow_chain u &
(forall i, i < seg_length u ->
inc (segment i u) (edges a)).

Definition vertex_uple u :=
concatenate 
(Uple.create (fun i => source (segment i u)) (seg_length u))
(uple1 (target u)).

Definition vertex_uple' u := 
concatenate (uple1 (source u))
(Uple.create (fun i => target (segment i u)) (seg_length u)).

Lemma length_vertex_uple : forall u,
length (vertex_uple u) = seg_length u + 1.
Proof.
ir. uf vertex_uple. rw length_concatenate. 
rw length_create. rw length_uple1. tv. 
Qed.

Lemma length_vertex_uple' : forall u,
length (vertex_uple' u) = seg_length u + 1.
Proof.
ir. uf vertex_uple'. rw length_concatenate. 
rw length_create. rw length_uple1. tv. 
om. Qed.



Lemma vertex_uples_same : forall u,
arrow_chain u -> 
vertex_uple u = vertex_uple' u.
Proof.
ir. 
ap uple_extensionality. 
uf vertex_uple. 
ap concatenate_axioms. 
uf vertex_uple'. 
ap concatenate_axioms. 
rw length_vertex_uple. rww length_vertex_uple'. 

ir. 
apply by_cases with (0 < i); ir. 
apply by_cases with (i < seg_length u); ir.
uf vertex_uple. rw component_concatenate_first.
rw component_create. 
uf vertex_uple'. rw component_concatenate_second. 
rw component_create. rw length_uple1. 
uh H; ee. 
transitivity (source (segment ((i-1) + 1) u)).
assert (i-1+1 = i). om. 
rw H8. tv. ap H6. om. om. 
rw length_uple1. rw length_create. om. 
rw length_uple1. om. am. 
rw length_create. am. 


assert (i = seg_length u). 
rwi length_vertex_uple H0. om. rw H3. 
uf vertex_uple. rw component_concatenate_second.
rw length_create. rw component_uple1. 

uf vertex_uple'. rw component_concatenate_second. 
rw length_uple1. rw component_create. uh H; ee.
rw H6. tv. om. om. rw length_uple1. 
rw length_create. om. rw length_uple1. om.
om. rw length_create. rw length_uple1. 
om. rw length_create. om. 

assert (i=0). om. rw H2. 
apply by_cases with (0 < seg_length u); ir.
uf vertex_uple. rw component_concatenate_first. 
rw component_create. uf vertex_uple'. 
rw component_concatenate_first. rw component_uple1. 
uh H; ee. ap H5. am. 
om. rw length_uple1; om. am. 
rw length_create. am. 

assert (seg_length u = 0). om. 

uf vertex_uple. rw component_concatenate_second. 
rw length_create. rw component_uple1. 
uf vertex_uple'. 
rw component_concatenate_first. rw component_uple1. 
uh H; ee. sy; ap H9. am. om. 
rw length_uple1. om. om. 
rw length_create. rw length_uple1. 
om. rw length_create. om. 
Qed.


Definition freecat_comp u v :=
Arrow.create (source v) (target u)
(concatenate (arrow v) (arrow u)).

Lemma seg_length_freecat_comp : forall u v,
seg_length (freecat_comp u v) = seg_length u + seg_length v.
Proof.
ir. uf freecat_comp. 
uf seg_length. rw Arrow.arrow_create. rww length_concatenate. 
rww plus_comm. 
Qed. 

Lemma segment_freecat_comp_first : forall u v i,
i < seg_length v -> segment i (freecat_comp u v) 
= segment i v.
Proof.
ir. uf freecat_comp. uf segment. 
rw Arrow.arrow_create. 
rw component_concatenate_first. tv. 
am. 
Qed.

Lemma segment_freecat_comp_second : forall u v i,
seg_length v <= i -> i < seg_length u + seg_length v ->
segment i (freecat_comp u v) = 
segment (i -seg_length v) u.
Proof.
ir. uf freecat_comp. uf segment. 
rw Arrow.arrow_create. 
rw component_concatenate_second.
tv. ufi seg_length H0. om. 
am. 
Qed. 
 

Definition freecat_id x := 
Arrow.create x x emptyset.

Lemma seg_length_freecat_id : forall x, 
seg_length (freecat_id x) = 0.
Proof.
ir. uf freecat_id. 
uf seg_length. rw Arrow.arrow_create. 
rww length_emptyset. 
Qed. 

Lemma arrow_chain_extensionality : forall u v,
arrow_chain u -> arrow_chain v ->
seg_length u = seg_length v ->
source u = source v -> target u = target v -> 
(forall i, i< seg_length u -> segment i u = segment i v) ->
u = v.
Proof.
ir. 
assert (Arrow.like u). 
uh H; ee; am. 
assert (Arrow.like v). 
uh H0; ee; am. 
uh H5; uh H6. rw H5; rw H6.
rw H2. rw H3. ap uneq. 
ap uple_extensionality. 
uh H; ee; am. uh H0; ee; am. 
am. am. 
Qed. 

Definition freecat_edge b :=
Arrow.create (source b) (target b) (uple1 b).

Lemma seg_length_freecat_edge : forall b,
seg_length (freecat_edge b) = 1.
Proof.
ir. uf freecat_edge. 
uf seg_length. rw Arrow.arrow_create. 
rww length_uple1. 
Qed.

Lemma segment_freecat_edge : forall b i,
i = 0 -> segment i (freecat_edge b) = b.
Proof.
ir. uf freecat_edge; uf segment.
rw Arrow.arrow_create. 
rw component_uple1. tv. om. 
Qed.

Lemma source_first_segment : forall u i,
arrow_chain u -> 0 < seg_length u -> i = 0 ->
source (segment i u) = source u. 
Proof.
ir. 
uh H; ee. rw H1. ap H3. am. 
Qed.

Lemma target_last_segment : forall u i,
arrow_chain u -> 0 < seg_length u -> 
i = seg_length u - 1 -> 
target (segment i u) = target u.
Proof.
ir. uh H; ee. rw H1. ap H4. am. 
Qed. 

Lemma eq_freecat_edge : forall u x,
arrow_chain u -> seg_length u = 1 ->
x = (segment 0 u) ->
u = freecat_edge x.
Proof.
ir. 
rw H1. 
uf freecat_edge. 
uh H; ee. uh H. 
transitivity (Arrow.create (source u) (target u) (arrow u)).
am. rw source_first_segment. 
rw target_last_segment. 
ap uneq. ap eq_uple1. 
am. am. tv. uhg; ee; am. om. 
om. uhg; ee; am. om. tv. 
Qed.




Lemma source_freecat_id : forall x,
source (freecat_id x) = x.
Proof.
ir. uf freecat_id. 
rww Arrow.source_create. 
Qed.

Lemma target_freecat_id : forall x, 
target (freecat_id x) = x.
Proof.
ir. uf freecat_id. 
rww Arrow.target_create. 
Qed.

Lemma source_freecat_edge : forall b,
source (freecat_edge b) = source b.
Proof.
ir. uf freecat_edge. rww Arrow.source_create. 
Qed.

Lemma target_freecat_edge : forall b,
target (freecat_edge b) = target b.
Proof.
ir. uf freecat_edge. rww Arrow.target_create. 
Qed.

Lemma source_freecat_comp : forall u v,
source (freecat_comp u v) = source v.
Proof.
ir. 
uf freecat_comp. rww Arrow.source_create. 
Qed.

Lemma target_freecat_comp : forall u v,
target (freecat_comp u v) = target u.
Proof.
ir. 
uf freecat_comp. rww Arrow.target_create. 
Qed.


Lemma arrow_freecat_id : forall x, 
arrow (freecat_id x) = emptyset.
Proof.
ir. uf freecat_id. rw Arrow.arrow_create.
tv. 
Qed.

Lemma arrow_freecat_edge : forall b,
arrow (freecat_edge b) = uple1 b.
Proof.
ir. uf freecat_edge. rw Arrow.arrow_create.
tv. 
Qed.

Lemma arrow_freecat_comp : forall u v,
arrow (freecat_comp u v) = 
concatenate (arrow v) (arrow u). 
Proof.
ir. uf freecat_comp. rw Arrow.arrow_create.
tv. 
Qed.

Lemma arrow_chain_freecat_id : forall x,
arrow_chain (freecat_id x).
Proof.
ir. 
uhg; ee. 
uf freecat_id. rww Arrow.create_like. 
rw arrow_freecat_id. 
ap Uple.empty_axioms. 
ir. 
rwi seg_length_freecat_id H. 
elim (lt_irrefl _ H). 
ir. 
rwi seg_length_freecat_id H. 
elim (lt_irrefl _ H). 
ir. 
rwi seg_length_freecat_id H. 
assert (1 = 0). om. discriminate H0. 
ir. 
rw source_freecat_id. rww target_freecat_id. 
Qed. 

Lemma eq_freecat_id : forall u,
arrow_chain u -> seg_length u = 0 -> 
u = freecat_id (source u).
Proof.
ir. ap arrow_chain_extensionality. 
am. 
ap arrow_chain_freecat_id. 
rw seg_length_freecat_id. am. 
rw source_freecat_id. tv. 
rw target_freecat_id. 
uh H; ee. sy; au. 
ir. assert (0=1). om. 
discriminate H2. 
Qed. 


Lemma arrow_chain_freecat_edge : forall b,
arrow_chain (freecat_edge b).
Proof.
ir. 
uhg; ee. 
uf freecat_edge. 
rww Arrow.create_like. 
rw arrow_freecat_edge. 
ap uple1_axioms. 

ir. 
rw segment_freecat_edge. rww source_freecat_edge. 
tv. 

ir. rw seg_length_freecat_edge. 
rw segment_freecat_edge. rww target_freecat_edge. 
om. 

ir. rwi seg_length_freecat_edge H. 
assert (0 = 1). om. discriminate H0. 
ir. rwi seg_length_freecat_edge H. discriminate H. 
Qed. 

Lemma arrow_chain_freecat_comp : forall u v,
arrow_chain u -> arrow_chain v -> source u = target v ->
arrow_chain (freecat_comp u v).
Proof.
ir. 
uhg; ee. 
uf freecat_comp. 
rww Arrow.create_like. 
uf freecat_comp. rw Arrow.arrow_create. 
ap concatenate_axioms. 

ir. 
rwi seg_length_freecat_comp H2. 
assert ((seg_length v = 0 /\ 0 < seg_length u) \/ 0 < seg_length v).
om. nin H3. ee. 
rw segment_freecat_comp_second. rw H3. 
rw source_freecat_comp. 
uh H0; ee.
cp (H9 H3). rw H10. wr H1. 
uh H; ee. assert (0 -0 = 0). tv. rw H16. 
ap H12. am. om. am. 

rw segment_freecat_comp_first. 
rw source_freecat_comp. uh H0; ee.
au. am. 


ir. 
rwi seg_length_freecat_comp H2. 
assert (0 < seg_length u \/ (seg_length u = 0 /\ 0 < seg_length v)).
om. 
nin H3. rw seg_length_freecat_comp. 
rw segment_freecat_comp_second. 
rw target_freecat_comp. 
assert (seg_length u + seg_length v - 1 - seg_length v
= seg_length u - 1).
om. rw H4. uh H; ee. 
au. om. om. 

ee. rw seg_length_freecat_comp. rw segment_freecat_comp_first.
rw target_freecat_comp. 
uh H; ee. cp (H9 H3). wr H10. rw H1. 
rw H3. assert (0 + seg_length v - 1 = seg_length v - 1).
om. rw H11. uh H0; ee.
au. om. 

ir. rwi seg_length_freecat_comp H2. 
apply by_cases with (i+1 < seg_length v); ir. 
rw segment_freecat_comp_first. 
rw segment_freecat_comp_first. uh H0; ee; au. 
om. om. 
apply by_cases with (i + 1 = seg_length v); ir.
rw segment_freecat_comp_second; try om. 
rw segment_freecat_comp_first; try om. 
uh H; uh H0; ee.
assert (i + 1 - seg_length v = 0).
rw H4. 
auto with arith. 
rw H15. rw H11. 
assert (i = seg_length v - 1). 
wr H4. clear H1 H2 H3 H4 H5 H6 H7 H8 H9 H10.
clear H0 H11 H12 H13 H14 H15. 
om. rw H16. rw H7. am. 
clear H1 H2 H3 H5 H6 H7 H8 H9 H10
H0 H11 H12 H13 H14 H15. 
om. 
clear H1 H3 H5 H6 H7 H8 H9 H10
H0 H11 H12 H13 H14 H15. 
om. 

assert (seg_length v < i+1).
om. assert (seg_length v <= i). om. 
rw segment_freecat_comp_second; try om. 
rw segment_freecat_comp_second; try om. 
set (j:= i-seg_length v). 
assert (i + 1 - seg_length v = j +1). uf j; om. 
rw H7. uh H; ee. 
ap H11. om. 

ir. rwi seg_length_freecat_comp H2. 
assert (seg_length u = 0 /\ seg_length v = 0). 
om. ee. 
uh H; uh H0. 
ee. cp (H9 H4). 
cp (H14 H3). rw source_freecat_comp. 
rw target_freecat_comp. rw H15. wr H16. sy; am. 
Qed.

Lemma arrow_like_extensionality : forall a b,
Arrow.like a -> Arrow.like b ->
source a = source b -> target a = target b ->
arrow a = arrow b -> a = b.
Proof.
ir. uh H; uh H0; rw H; rw H0.
rw H1; rw H2; rw H3. reflexivity. 
Qed.


Lemma freecat_assoc : forall u v w,
freecat_comp u (freecat_comp v w) =
freecat_comp (freecat_comp u v) w.
Proof.
ir. 
ap arrow_like_extensionality. 
uf freecat_comp; rww Arrow.create_like. 
uf freecat_comp; rww Arrow.create_like. 
rw source_freecat_comp. 
rw source_freecat_comp. 
rw source_freecat_comp. tv. 
rw target_freecat_comp. 
rw target_freecat_comp. 
rw target_freecat_comp. tv. 
rw arrow_freecat_comp. 
rw arrow_freecat_comp. 
rw arrow_freecat_comp. 
rw arrow_freecat_comp. 
sy; ap concatenate_assoc. 
Qed.

Lemma freecat_left_id' : forall u x,
Arrow.like u -> x = target u -> Uple.axioms (arrow u) ->
freecat_comp (freecat_id x) u = u.
Proof.
ir. 
ap arrow_like_extensionality. 
uf freecat_comp; rww Arrow.create_like. am. 
rw source_freecat_comp. tv. 
rw target_freecat_comp. rw target_freecat_id. 
am. 
rw arrow_freecat_comp. 
rw arrow_freecat_id. rw concatenate_emptyset_right.
tv. am. 
Qed.

Lemma freecat_right_id' : forall u x,
Arrow.like u -> x = source u -> Uple.axioms (arrow u) ->
freecat_comp u (freecat_id x) = u.
Proof.
ir. 
ap arrow_like_extensionality. 
uf freecat_comp; rww Arrow.create_like. am. 
rw source_freecat_comp. tv. 
rw source_freecat_id. am. 
rw target_freecat_comp. tv. 
rw arrow_freecat_comp. 
rw arrow_freecat_id. rw concatenate_emptyset_left.
tv. am. 
Qed.

Lemma freecat_left_id : forall u x,
arrow_chain u -> x = target u ->
freecat_comp (freecat_id x) u = u.
Proof.
ir. ap freecat_left_id'. uh H; ee; am. 
am. uh H; ee; am. 
Qed.

Lemma freecat_right_id : forall u x,
arrow_chain u -> x = source u ->
freecat_comp u (freecat_id x) = u.
Proof.
ir. ap freecat_right_id'. uh H; ee; am. 
am. uh H; ee; am. 
Qed.

Lemma uples_contained : forall b u,
Uple.axioms u -> 
(forall i, i<length u -> inc (component i u) b) ->
inc u (powerset (Cartesian.product nat b)).
Proof.
ir. 
rw powerset_inc_rw. 
uhg; ir. 
assert (is_pair x).
uh H; ee. 
uh H; ee. cp (H _ H1).
wr H4. 
ap pair_is_pair. 
assert (inc (pr1 x) (domain u)).
uh H; ee. app Function.lem2. 
assert (inc (pr1 x) nat).
uh H; ee. assert (sub (domain u) nat).
assert (domain u = R (B H4)). rw B_eq. tv. 
rw H5. ap sub_R_nat. ap H5. am. 
assert (inc (pr2 x) b). 
assert (pr2 x = V (pr1 x) u). 
ap Function.pr2_V. uh H; ee; am. am. 
rw H5. set (j:= Bnat (pr1 x)). 
assert (pr1 x = R j). uf j. rww R_Bnat. rw H6. 
change (inc (component j u) b). ap H0. 
rwi H6 H3. wr inc_lt. uf length. rw R_Bnat. am. 
uh H; ee. am. 
ap product_inc. am. am. am. 
Qed.


Lemma mor_freecat_from_set : forall a u,
mor_freecat a u -> 
inc u (Image.create 
(product (product (vertices a) (vertices a))
(powerset (product nat (edges a))))
(fun x => Arrow.create (pr1 (pr1 x)) (pr2 (pr1 x)) (pr2 x))).
Proof.
ir. 
rw Image.inc_rw. 
sh (pair (pair (source u) (target u)) (arrow u)).
ee. 
ap product_pair_inc. 
ap product_pair_inc. uh H; ee. am. 
uh H; ee; am. 
ap uples_contained. 
uh H; ee. 
uh H2; ee; am. uh H; ee. am. 
rw pr1_pair. rw pr1_pair. rw pr2_pair. rw pr2_pair. 
uh H; ee. uh H2; ee; sy; am. 
Qed.


Lemma mor_freecat_bounded : forall a,
Bounded.axioms (mor_freecat a).
Proof.
ir. 
ap Bounded.criterion. sh
(Image.create 
(product (product (vertices a) (vertices a))
(powerset (product nat (edges a))))
(fun x => Arrow.create (pr1 (pr1 x)) (pr2 (pr1 x)) (pr2 x))). 
ir. app mor_freecat_from_set. 
Qed. 

Definition freecat_morphisms a :=
Bounded.create (mor_freecat a).

Lemma inc_freecat_morphisms : forall a u,
inc u (freecat_morphisms a) = mor_freecat a u.
Proof.
ir. 
uf freecat_morphisms. 
rw Bounded.inc_create. tv. ap mor_freecat_bounded. 
Qed. 

Definition freecat a :=
Category.Notations.create 
(vertices a) (freecat_morphisms a) freecat_comp freecat_id
emptyset.

Lemma is_mor_freecat : forall a u,
is_mor (freecat a) u =  mor_freecat a u.
Proof.
ir. 
uf freecat. 
rw is_mor_create. rww inc_freecat_morphisms. 
Qed.

Lemma is_ob_freecat : forall a x,
is_ob (freecat a) x = inc x (vertices a).
Proof.
ir. uf freecat. rww is_ob_create. 
Qed.

Lemma comp_freecat1 : forall a u v,
mor_freecat a u -> mor_freecat a v ->
source u = target v -> 
comp (freecat a) u v = freecat_comp u v.
Proof.
ir. uf freecat. rww comp_create. 
rww inc_freecat_morphisms. rww inc_freecat_morphisms.
Qed.

Lemma id_freecat1 : forall a x,
inc x (vertices a) -> 
id (freecat a) x = freecat_id x.
Proof.
ir. uf freecat. rww id_create. 
Qed.

Lemma structure_freecat : forall a,
structure (freecat a) = emptyset.
Proof.
ir. uf freecat. rww structure_create. 
Qed.

Lemma mor_freecat_id : forall a x,
inc x (vertices a) -> axioms a ->
mor_freecat a (freecat_id x).
Proof.
ir. uhg; ee. am. 
rw source_freecat_id. am. 
rww target_freecat_id. 
app arrow_chain_freecat_id. 
ir. rwi seg_length_freecat_id H1. 
assert (1=0). om. discriminate H2. 
Qed. 

Lemma mor_freecat_comp : forall a u v,
mor_freecat a u -> mor_freecat a v ->
source u = target v -> 
mor_freecat a (freecat_comp u v).
Proof.
ir. uhg; ee. 
uh H; ee; am. 
rw source_freecat_comp. uh H0; ee; am. 
rw target_freecat_comp. uh H; ee; am. 
uh H; uh H0; ee; app arrow_chain_freecat_comp.
ir. rwi seg_length_freecat_comp H2. 
apply by_cases with (i<seg_length v); ir. 
rw segment_freecat_comp_first. 
uh H0; ee; au. am. 
rw segment_freecat_comp_second. 
uh H; ee. ap H7. om. om. am. 
Qed. 

Lemma mor_freecat_edge : forall a u,
axioms a -> inc u (edges a) -> 
mor_freecat a (freecat_edge u).
Proof.
ir. uhg; ee. am. 
rww source_freecat_edge. 
uh H; ee. au. 
rw target_freecat_edge. uh H; ee; au. 
ap arrow_chain_freecat_edge. 

ir. rwi seg_length_freecat_edge H1. 
rw segment_freecat_edge. am. om. 
Qed. 

Lemma freecat_axioms : forall a,
axioms a -> Category.axioms (freecat a).
Proof.
ir. uf freecat. 
ap Category.create_axioms. 
uhg; ee. 
ir. ap iff_eq; ir. uhg; ee. am. 
rw inc_freecat_morphisms. app mor_freecat_id. 
rww source_freecat_id. rww target_freecat_id. 
uh H0; ee; am. 

ir. ap iff_eq; ir. 
rwi inc_freecat_morphisms H0.
uhg; ee. rww inc_freecat_morphisms.  
uh H0; ee; am. uh H0; ee; am. 
rw freecat_right_id. tv. 
uh H0; ee; am. tv. 
rww freecat_left_id. uh H0; ee; am. 
uh H0; ee. uh H3; ee; am. 
uh H0; ee; am. 

ir. cp H0; cp H1. 
rwi inc_freecat_morphisms H0. 
rwi inc_freecat_morphisms H1. 
uhg; ee; try am. 
rw inc_freecat_morphisms. 
app mor_freecat_comp. 
rww source_freecat_comp. 
rww target_freecat_comp. 

ir. 
rwi inc_freecat_morphisms H0. 
rwi inc_freecat_morphisms H1. 
rwi inc_freecat_morphisms H2.
rw freecat_assoc. 
tv. 
Qed. 


Lemma mor_freecat_rw : forall a u,
Graph.axioms a -> 
mor (freecat a) u = mor_freecat a u.
Proof.
ir. 
ap iff_eq; ir. uh H0; ee. rwi is_mor_freecat H1. am. 
ap is_mor_mor. ap freecat_axioms. am. 
rw is_mor_freecat. am. 
Qed. 

Lemma ob_freecat_rw : forall a x,
Graph.axioms a ->
ob (freecat a) x = inc x (vertices a).
Proof.
ir. 
ap iff_eq; ir. uh H0; ee. rwi is_ob_freecat H1. am. 
ap is_ob_ob. ap freecat_axioms. am. 
rw is_ob_freecat. am. 
Qed. 

Lemma id_freecat : forall a x,
Graph.axioms a -> ob (freecat a) x -> 
id (freecat a) x = freecat_id x.
Proof.
ir. rw id_freecat1. tv. 
rwi ob_freecat_rw H0. tv. am. 
Qed. 

Lemma comp_freecat : forall a u v,
Graph.axioms a -> mor (freecat a) u -> 
mor (freecat a) v -> source u = target v ->
comp (freecat a) u v = freecat_comp u v.
Proof.
ir. rww comp_freecat1. 
wrr mor_freecat_rw. wrr mor_freecat_rw. 
Qed. 







Definition mor_chain a u :=
arrow_chain u &
Category.axioms a &
ob a (source u) & ob a (target u) &
(forall i, i< (seg_length u) -> mor a (segment i u)).

Lemma mor_chain_freecat_id : forall a x,
ob a x -> mor_chain a (freecat_id x).
Proof.
ir. uhg. ee. 
ap arrow_chain_freecat_id. uh H; ee; am. 

rww source_freecat_id. 
rww target_freecat_id. 
ir. 
rwi seg_length_freecat_id H0. 
assert (0=1). om. discriminate H1. 
Qed. 

Lemma mor_chain_freecat_comp : forall a u v,
mor_chain a u -> mor_chain a v ->
source u = target v -> mor_chain a (freecat_comp u v).
Proof.
ir. uhg; ee. 
ap arrow_chain_freecat_comp. uh H; ee; am. 
uh H0; ee; am. am. uh H; ee. am. 

rw source_freecat_comp. lu. 
rw target_freecat_comp. lu. 

ir. rwi seg_length_freecat_comp H2. 
assert (i < seg_length v \/ 
(i-seg_length v < seg_length u /\ 
seg_length v <= i)).
om. nin H3. 
rw segment_freecat_comp_first. uh H0; ee.
ap H7. am. am. 
ee. rw segment_freecat_comp_second. 
uh H; ee. ap H8. am. am. am. 
Qed.

Lemma mor_chain_freecat_edge : forall a u,
mor a u -> mor_chain a (freecat_edge u).
Proof.
ir. uhg; ee.
ap arrow_chain_freecat_edge. uh H; ee; am. 
rw source_freecat_edge. rww ob_source. 
rw target_freecat_edge; rww ob_target. 
ir. rw segment_freecat_edge. am. 
rwi seg_length_freecat_edge H0. om. 
Qed. 

Definition chain_tack u v :=
freecat_comp (freecat_edge u) v.

Lemma arrow_chain_chain_tack : forall u v,
arrow_chain v -> 
source u = target v -> arrow_chain (chain_tack u v).
Proof.
ir. uf chain_tack. 
ap arrow_chain_freecat_comp. ap arrow_chain_freecat_edge.
am. rww source_freecat_edge. 
Qed. 

Lemma source_chain_tack : forall u v,
source (chain_tack u v) = source v.
Proof.
ir. uf chain_tack. rw source_freecat_comp. tv. 
Qed.

Lemma target_chain_tack : forall u v,
target (chain_tack u v) = target u.
Proof.
ir. uf chain_tack. rw target_freecat_comp.
rww target_freecat_edge. 
Qed. 

Lemma arrow_chain_tack : forall u v,
arrow (chain_tack u v) = utack u (arrow v).
Proof.
ir. uf chain_tack. 
rw arrow_freecat_comp. 
rw arrow_freecat_edge. tv. 
Qed. 

Lemma seg_length_chain_tack : forall u v,
seg_length (chain_tack u v) = seg_length v + 1.
Proof.
ir. uf chain_tack. 
rw seg_length_freecat_comp. rw seg_length_freecat_edge.
om. 
Qed. 

Lemma segment_chain_tack_old : forall u v i,
i < seg_length v ->
segment i (chain_tack u v) = segment i v.
Proof.
ir. uf chain_tack. 
rw segment_freecat_comp_first. tv. am. 
Qed.

Lemma segment_chain_tack_new : forall u v i,
i = seg_length v ->
segment i (chain_tack u v) = u.
Proof.
ir. uf chain_tack. 
rw segment_freecat_comp_second. 
rw segment_freecat_edge. tv. om. 
om. 
rw seg_length_freecat_edge. om. 
Qed. 

Lemma mor_chain_chain_tack : forall a u v,
mor_chain a v -> mor a u ->
source u = target v -> mor_chain a (chain_tack u v).
Proof.
ir. uhg; ee. 
ap arrow_chain_chain_tack. uh H; ee; am. 
am. uh H0; ee; am. 

rw source_chain_tack. lu. 
rw target_chain_tack. rww ob_target. 

ir. assert (i < seg_length v \/ i = seg_length v).
rwi seg_length_chain_tack H2. om. 
nin H3. rw segment_chain_tack_old. 
uh H; ee; au. am. 
rw segment_chain_tack_new. am. am. 
Qed. 


Definition object_number i u :=
Y (i< seg_length u) (source (segment i u)) (target u).

Lemma object_number_zero : forall u,
arrow_chain u -> object_number 0 u = source u.
Proof.
ir. uf object_number. 
assert (0<seg_length u \/ seg_length u = 0).
om. nin H0. 

rw Y_if_rw. uh H; ee. au. am. 
rw Y_if_not_rw. uh H; ee. sy; au. rw H0; om. 
Qed.

Lemma object_number_seg_length : forall u ,
arrow_chain u -> object_number (seg_length u) u = target u.
Proof.
ir. uf object_number. 
rw Y_if_not_rw. tv. om. 
Qed.

Lemma source_segment : forall i u,
arrow_chain u -> i < seg_length u -> 
source (segment i u) = object_number i u.
Proof.
ir. uf object_number. 
rww Y_if_rw. 
Qed.

Lemma target_segment : forall i u,
arrow_chain u -> i < seg_length u ->
target (segment i u) = object_number (i+1) u.
Proof.
ir. 
uf object_number. 
assert (i+1 < seg_length u \/ i +1 = seg_length u).
om. nin H1. 
rw Y_if_rw. uh H; ee. sy; au. am. 
rw Y_if_not_rw. uh H; ee. wr H4. 
assert (i = seg_length u -1). om. 
rww H7. om. om. 
Qed. 

Definition chain_restrict i u :=
Arrow.create (source u) (object_number i u) 
(restrict (arrow u) i).

Lemma source_chain_restrict : forall i u,
source (chain_restrict i u) = source u.
Proof.
ir. uf chain_restrict. 
rw Arrow.source_create. tv. 
Qed.

Lemma target_chain_restrict : forall i u,
target (chain_restrict i u) = object_number i u.
Proof.
ir. uf chain_restrict. 
rw Arrow.target_create. tv. 
Qed.

Lemma seg_length_chain_restrict : forall i u,
seg_length (chain_restrict i u) = i.
Proof.
ir. uf chain_restrict. 
uf seg_length. 
rw Arrow.arrow_create. 
rw length_restrict. tv. 
Qed. 

Lemma segment_chain_restrict : forall i j u,
j < i -> 
segment j (chain_restrict i u) = segment j u.
Proof.
ir. uf chain_restrict. 
uf segment. rw Arrow.arrow_create. 
rw component_restrict. tv. am. 
Qed. 

Lemma arrow_chain_chain_restrict : forall i u,
arrow_chain u ->  i <= seg_length u ->
arrow_chain (chain_restrict i u).
Proof.
ir. uhg; ee. 
uf chain_restrict. rww Arrow.create_like. 
uf chain_restrict. 
rw Arrow.arrow_create. 
uf restrict. 
ap create_axioms. 

ir. rw segment_chain_restrict. 
rw source_chain_restrict. uh H; ee. ap H3.
rwi seg_length_chain_restrict H1. om. 
rwi seg_length_chain_restrict H1; am. 

ir. rwi seg_length_chain_restrict H1. 
rw seg_length_chain_restrict. 
rw segment_chain_restrict. 
rw target_chain_restrict. 
rw target_segment. assert (i-1+1=i).
om. rww H2. am. om. om. 

ir. rwi seg_length_chain_restrict H1. 
rw segment_chain_restrict. 
rw segment_chain_restrict. rw source_segment.
rw target_segment. tv. am. om. am. 
om. om. om. 

ir. 
rwi seg_length_chain_restrict H1. rw H1. 
rw source_chain_restrict. 
rw target_chain_restrict. rw object_number_zero. tv. 
am. 
Qed. 

Lemma chain_restrict_refl : forall u,
arrow_chain u ->
chain_restrict (seg_length u) u = u.
Proof.
ir. ap arrow_chain_extensionality. 
ap arrow_chain_chain_restrict. am. 
om. am. 
rw seg_length_chain_restrict. tv. 
rw source_chain_restrict. tv. 
rw target_chain_restrict. rw object_number_seg_length. 
tv. am. 

ir. rwi seg_length_chain_restrict H0. 
rw segment_chain_restrict. tv. am. 
Qed.

Lemma eq_chain_tack_restrict : forall u,
arrow_chain u -> seg_length u > 0 ->
u = chain_tack (segment (seg_length u - 1) u) 
(chain_restrict (seg_length u - 1) u).
Proof.
ir. 
ap arrow_chain_extensionality. am. 
ap arrow_chain_chain_tack. 
ap arrow_chain_chain_restrict. am. 
om. cp H. 
uh H; ee. 
rw source_segment. 
rw target_chain_restrict. 
tv. am. om. 

rw seg_length_chain_tack. 
rw seg_length_chain_restrict. om. 
rw source_chain_tack. rw source_chain_restrict. 
tv. rw target_chain_tack. 
rw target_segment. 
assert (seg_length u - 1 + 1 = seg_length u).
om. rw H1. rw object_number_seg_length. tv.
am. am. om. 

ir. 
assert (i < seg_length u - 1 \/ i = seg_length u - 1).
om. nin H2. 
rw segment_chain_tack_old. 
rw segment_chain_restrict. tv. am. 
rw seg_length_chain_restrict. am. 

rw segment_chain_tack_new. rww H2. 
rw seg_length_chain_restrict. am. 
Qed.

Lemma arrow_chain_induction : forall (P:E->Prop),
(forall x, P (freecat_id x)) ->
(forall u v, arrow_chain v -> source u = target v ->
P v -> P (chain_tack u v)) ->
(forall y, arrow_chain y -> P y).
Proof.
intros P H H0. 
assert (forall n y, seg_length y <= n -> arrow_chain y -> P y).
intro n. 
nin n. 

ir. assert (seg_length y = 0). om. 
assert (y = freecat_id (source  y)). ap eq_freecat_id. 
am. am. rw H4. ap H. 

ir. 
assert (seg_length y = S n \/ seg_length y < S n).
om. nin H3. 
util (eq_chain_tack_restrict (u:=y)). 
am. om. rw H4. ap H0. 
ap arrow_chain_chain_restrict. am. om. 
rw target_chain_restrict. 
rw source_segment. tv. am. om. 
ap IHn. 
rw seg_length_chain_restrict. om. 
ap arrow_chain_chain_restrict. am. om. 

ap IHn. om. am. 

ir. 
ap (H1 (seg_length y)). om. am. 
Qed. 

Lemma mor_chain_chain_restrict : forall a u i,
mor_chain a u -> i <= seg_length u ->
mor_chain a (chain_restrict i u).
Proof.
ir. uhg; ee. 
ap arrow_chain_chain_restrict. uh H; ee; am. 
am. uh H; ee; am. 
rw source_chain_restrict. lu. 
rw target_chain_restrict. 
assert (i < seg_length u \/ i = seg_length u).
om. nin H1. 
assert (object_number i u = source (segment i u)). 
rww source_segment. lu. 
rw H2. uh H; ee. 
rww ob_source. au. 
assert (object_number i u = target u).
rw H1. rw object_number_seg_length. tv. lu. 
rw H2. lu. 
ir. uh H; ee. 
rw segment_chain_restrict. ap H5. 
rwi seg_length_chain_restrict H1. om. 
rwi seg_length_chain_restrict H1. am. 
Qed. 

Lemma chain_restrict_chain_tack : forall u v i,
i = seg_length v -> arrow_chain v -> 
source u = target v -> 
chain_restrict i (chain_tack u v) = v.
Proof.
ir. ap arrow_chain_extensionality.
ap arrow_chain_chain_restrict. 
app arrow_chain_chain_tack. 
rw seg_length_chain_tack. om. 
am. 
rw seg_length_chain_restrict. am. 
rw source_chain_restrict. rww source_chain_tack.
rw target_chain_restrict. 
transitivity (source (segment i (chain_tack u v))).
rw source_segment. tv. 
app arrow_chain_chain_tack. rw seg_length_chain_tack.
om. 
rw segment_chain_tack_new. am. am. 

ir. rwi seg_length_chain_restrict H2. 
rw segment_chain_restrict. rw segment_chain_tack_old. 
tv. om. am. 
Qed. 



Lemma mor_chain_induction : forall a (P:E->Prop),
(forall x, ob a x -> P (freecat_id x)) ->
(forall u v, mor_chain a v -> mor a u ->
source u = target v -> P v -> P (chain_tack u v)) ->
(forall y, mor_chain a y -> P y).
Proof.
ir. generalize H1. 

apply arrow_chain_induction with (P:=fun z => (mor_chain a z -> P z)).
ir. 
ap H. 
uh H2. ee. rwi source_freecat_id H4. am. 

ir. 
assert (lem1 : mor_chain a v).
assert (v = chain_restrict (seg_length v) (chain_tack u v)).
rw chain_restrict_chain_tack. tv. tv. am. 
am. rw H6. 
ap mor_chain_chain_restrict. am. 
rw seg_length_chain_tack. om. 



assert (lem2 : mor a u).
assert  (u = segment (seg_length v) (chain_tack u v)).
rw segment_chain_tack_new. tv. tv. 
rw H6. uh H5; ee. ap H10. 
rw seg_length_chain_tack. om. 

ap H0. am. am. am. ap H4; am. 
lu. 
Qed.



Definition compose_chain a u :=
iterate (seg_length u) (fun i v => comp a (segment i u) v) 
(id a (source u)).

Lemma compose_chain_freecat_id : forall a x,
compose_chain a (freecat_id x) = id a x.
Proof.
ir. uf compose_chain. 
rw seg_length_freecat_id. 
rw iterate_0. rw source_freecat_id. tv. 
Qed.

Lemma compose_chain_chain_tack : forall a u v,
compose_chain a (chain_tack u v) =
comp a u (compose_chain a v).
Proof.
ir. 
set (k:= compose_chain a v). 
uf compose_chain. 
rw seg_length_chain_tack. 
rw iterate_nplus1. 
rww segment_chain_tack_new. 
uf k. uf compose_chain. ap uneq. 
apply iterate_same with (P:= fun (x:E) => True). 
tv. 
rw source_chain_tack. tv. tv. 
ir. tv. 
ir. 
rw segment_chain_tack_old. tv. tv. 
Qed.

Lemma compose_chain_freecat_edge : forall a u,
mor a u -> compose_chain a (freecat_edge u) = u.
Proof.
ir. assert (freecat_edge u = chain_tack u (freecat_id (source u))).
uf chain_tack. 
rw freecat_right_id. tv. 
ap arrow_chain_freecat_edge. rww source_freecat_edge. 
rw H0. 
rw compose_chain_chain_tack. rw compose_chain_freecat_id. 
rw right_id. tv. rww ob_source. am. tv. tv. 
Qed. 

Definition compose_chain_facts a u :=
mor_chain a u &
source (compose_chain a u) = source u &
target (compose_chain a u) = target u &
mor a (compose_chain a u).

Lemma compose_chain_facts_compose_chain : forall a u,
mor_chain a u -> compose_chain_facts a u.
Proof.
ir. apply mor_chain_induction with (a:= a)
(P:= fun u => compose_chain_facts a u). 
ir. uhg; ee. 
ap mor_chain_freecat_id. am. 
rw compose_chain_freecat_id. rw source_freecat_id. 
rww source_id. 
rw compose_chain_freecat_id. 
rw target_freecat_id. rww target_id. 
rw compose_chain_freecat_id. app mor_id. 

ir. uhg; ee. 
ap mor_chain_chain_tack. am. am. am. 
rw compose_chain_chain_tack. 
rw source_comp. uh H3; ee. 
rw H4. rw source_chain_tack. tv. am. 
uh H3; ee; am. 
uh H3; ee. rw H5. am. 

rw compose_chain_chain_tack. rw target_comp.
rw target_chain_tack. tv. am. 
uh H3; ee; am. 
uh H3; ee. rw H5. am. 
rw compose_chain_chain_tack. 
rw mor_comp. tv. am. 
uh H3; ee; am. 
uh H3; ee. rw H5. am. tv. am. 
Qed. 

Lemma source_compose_chain : forall a u,
mor_chain a u -> source (compose_chain a u) = source u.
Proof.
ir. cp (compose_chain_facts_compose_chain H). 
uh H0; ee; am. 
Qed.

Lemma target_compose_chain : forall a u,
mor_chain a u -> target (compose_chain a u) = target u.
Proof.
ir. cp (compose_chain_facts_compose_chain H). 
uh H0; ee; am. 
Qed. 



Lemma mor_compose_chain : forall a u, mor_chain a u ->
mor a (compose_chain a u).
Proof.
ir. cp (compose_chain_facts_compose_chain H). 
uh H0; ee; am. 
Qed. 

Lemma freecat_comp_chain_tack : forall y u v,
freecat_comp (chain_tack y u) v =
chain_tack y (freecat_comp u v).
Proof.
ir. uf chain_tack. rw freecat_assoc. tv. 
Qed. 

Lemma compose_chain_freecat_comp : forall a u v,
mor_chain a u -> mor_chain a v ->
source u = target v -> 
compose_chain a (freecat_comp u v) = 
comp a (compose_chain a u) (compose_chain a v).
Proof.
ir. 
assert (forall z, mor_chain a z -> source z = target v ->
compose_chain a (freecat_comp z v) =
comp a (compose_chain a z) (compose_chain a v)).
intros z H2. 
apply mor_chain_induction with (a:=a) 
(P:= fun w => source w = target v ->
compose_chain a (freecat_comp w v) =
comp a (compose_chain a w) (compose_chain a v)).

ir. 
rw freecat_left_id. 
rw compose_chain_freecat_id. 
rw left_id. tv. am. 
ap mor_compose_chain. am. 
rw target_compose_chain. rwi source_freecat_id H4. 
sy; am. am. tv. uh H0; ee; am. 
rwi source_freecat_id H4. am. 

ir. 
rw freecat_comp_chain_tack.

rw compose_chain_chain_tack. 
sy. rw compose_chain_chain_tack. 
rw assoc. wr H6. tv. 
rwi source_chain_tack H7. am. am. 
app mor_compose_chain. app mor_compose_chain. 
rww target_compose_chain. 
rww source_compose_chain. 
rww target_compose_chain. 
rwi source_chain_tack H7. am. tv. 
am. 
ap H2. am. am. 
Qed.



Definition chain_map (fo : E -> E) (fa:E -> E) u :=
Arrow.create 
(fo (source u)) (fo (target u)) (uple_map fa (arrow u)).

Lemma source_chain_map : forall fo fa u,
source (chain_map fo fa u) = fo (source u).
Proof.
ir. uf chain_map. 
rw Arrow.source_create. tv. 
Qed.

Lemma target_chain_map : forall fo fa u,
target (chain_map fo fa u) = fo (target u).
Proof.
ir. uf chain_map. 
rw Arrow.target_create. tv. 
Qed.

Lemma arrow_chain_map : forall fo fa u,
arrow (chain_map fo fa u) = uple_map fa (arrow u).
Proof.
ir. uf chain_map. 
rw Arrow.arrow_create. tv. 
Qed.

Lemma seg_length_chain_map : forall fo fa u,
seg_length (chain_map fo fa u) = seg_length u.
Proof.
ir. uf seg_length. 
rw arrow_chain_map. rw length_uple_map. tv. 
Qed.


Lemma segment_chain_map : forall fo fa u i,
i < seg_length u -> segment i (chain_map fo fa u) 
= fa (segment i u).
Proof.
ir. uf segment. 
rw arrow_chain_map. rw component_uple_map. 
tv. am. 
Qed. 

Lemma arrow_chain_chain_map : forall fo fa u,
arrow_chain u -> 
(forall i, i<seg_length u -> fo (source (segment i u)) =
source (fa (segment i u))) ->
(forall i, i<seg_length u -> fo (target (segment i u)) =
target (fa (segment i u))) ->
arrow_chain (chain_map fo fa u).
Proof.
ir. 
uhg; ee. uf chain_map. rww Arrow.create_like. 
rw arrow_chain_map. ap axioms_uple_map. 
ir. rwi seg_length_chain_map H2. 

rww segment_chain_map. 
rww source_chain_map. wrr H0. rww source_segment. 
rww object_number_zero. 


ir. rwi seg_length_chain_map H2. 

rww segment_chain_map. 
rww target_chain_map. wrr H1. rww target_segment. 
rw seg_length_chain_map. 
assert (seg_length u - 1 + 1 = seg_length u).
om. rw H3. rww object_number_seg_length. 

rw seg_length_chain_map. om. 
rw seg_length_chain_map. om. 
rw seg_length_chain_map. om. 


ir. rwi seg_length_chain_map H2. 
rw segment_chain_map. 
rw segment_chain_map. wr H0. wr H1. 
uh H; ee. rw H6. tv. am. om. 
om. om. om. 


rw seg_length_chain_map. ir. 
rw source_chain_map. rw target_chain_map. uh H; ee. 
rww H7. 
Qed. 



Lemma chain_map_freecat_id : forall fo fm x,
chain_map fo fm (freecat_id x) = freecat_id (fo x).
Proof.
ir. uf chain_map. 
rw source_freecat_id. rw target_freecat_id. 
rw arrow_freecat_id. rw uple_map_emptyset. 
tv. 
Qed.  



Lemma chain_map_freecat_edge : forall fo fm u,
source (fm u) = fo (source u) ->
target (fm u) = fo (target u) ->
chain_map fo fm (freecat_edge u) = freecat_edge (fm u).
Proof.
ir. 
uf chain_map. rw source_freecat_edge. 
rw target_freecat_edge. rw arrow_freecat_edge. 
rw uple_map_uple1. wr H. wr H0. tv. 
Qed.




Lemma chain_map_freecat_comp : forall fo fm u v,
chain_map fo fm (freecat_comp u v) =
freecat_comp (chain_map fo fm u) (chain_map fo fm v).
Proof.
ir. uf chain_map. 
rw source_freecat_comp. 
rw target_freecat_comp. 
rw arrow_freecat_comp. rw uple_map_concatenate. 
uf freecat_comp. 
rw Arrow.source_create. rw Arrow.target_create. 
rw Arrow.arrow_create. rw Arrow.arrow_create. tv. 
Qed.

Lemma chain_map_chain_tack : forall fo fm u v,
target (fm u) = fo (target u) ->
chain_map fo fm (chain_tack u v) = 
chain_tack (fm u) (chain_map fo fm v).
Proof.
ir. 
uf chain_map. rw source_chain_tack. rw target_chain_tack.
rw arrow_chain_tack. uf utack. 
rw uple_map_concatenate. 
rw uple_map_uple1. 
uf chain_tack. uf freecat_comp. 
rw Arrow.source_create. rw Arrow.arrow_create. 
rw target_freecat_edge. rw H. 
rw arrow_freecat_edge. tv. 
Qed. 




Definition free_functor g a fo fm :=
Functor.create (freecat g) a (fun u => 
(compose_chain a (chain_map fo fm u))).


Definition free_functor_property g a fo fm :=
Graph.axioms g &
Category.axioms a & 
(forall x, inc x (vertices g) -> ob a (fo x)) &
(forall u, inc u (edges g) -> mor a (fm u)) &
(forall u, inc u (edges g) -> source (fm u) = fo (source u)) &
(forall u, inc u (edges g) -> target (fm u) = fo (target u)).



Lemma source_free_functor : forall g a fo fm,
source (free_functor g a fo fm) = freecat g.
Proof.
ir. uf free_functor. rw Functor.source_create. tv. 
Qed.

Lemma target_free_functor : forall g a fo fm,
target (free_functor g a fo fm) = a.
Proof.
ir. uf free_functor. rw Functor.target_create. tv. 
Qed.

Lemma fmor_free_functor : forall g a fo fm u,
Graph.axioms g -> 
mor_freecat g u -> fmor (free_functor g a fo fm) u =
(compose_chain a (chain_map fo fm u)).
Proof.
ir. uf free_functor. 
rw fmor_create. tv. rw mor_freecat_rw.  am. am. 
Qed. 

Lemma mor_chain_chain_map : forall g a fo fm u,
free_functor_property g a fo fm ->
mor_freecat g u ->  
mor_chain a (chain_map fo fm u).
Proof.
ir. uhg; ee. 
ap arrow_chain_chain_map. uh H0; ee. am. 
ir. uh H; ee. sy; ap H5. uh H0; ee. 
ap H10. am. 

ir. uh H; uh H0; ee. sy; ap H10. ap H5. am. 
uh H; ee; am. rw source_chain_map. uh H; uh H0; ee. 
ap H6. am. 
rw target_chain_map. uh H; uh H0; ee. app H6. 

ir. rwi seg_length_chain_map H1. 
rww segment_chain_map. uh H; uh H0; ee.
ap H8. ap H5. am. 
Qed. 





Lemma fob_free_functor : forall g a fo fm x,
free_functor_property g a fo fm -> 
inc x (vertices g) ->
fob (free_functor g a fo fm) x = fo x.
Proof.
ir. uf fob. 
rw source_free_functor. rw id_freecat. 
rw fmor_free_functor. 
rw source_compose_chain. 
rw source_chain_map. rw source_freecat_id. tv. 
apply mor_chain_chain_map with g. am. 
ap mor_freecat_id. am. 
uh H; ee; am. uh H; ee; am. 
ap mor_freecat_id. am. uh H; ee; am. uh H; ee; am. 
rww ob_freecat_rw. uh H; ee; am. 
Qed. 

Lemma free_functor_axioms : forall g a fo fm,
free_functor_property g a fo fm -> 
Functor.axioms (free_functor g a fo fm).
Proof.
ir. 
cp H. 
uh H; ee. 
uhg; ee. uf free_functor. 
uf Functor.create. 
ap Umorphism.create_like. 
rw source_free_functor. 
app freecat_axioms. 
rw target_free_functor. 
am. 

ir. rwi source_free_functor H6. 
cp H6. rwi ob_freecat_rw H7. 
rw target_free_functor. rww fob_free_functor. 
ap H2. am. am. 

ir. rwi source_free_functor H6. cp H6. 
rwi ob_freecat_rw H7; try am. 
rw target_free_functor. rww fob_free_functor. 
rww fmor_free_functor. 
rw source_free_functor. rww id_freecat. 

rw chain_map_freecat_id. rw compose_chain_freecat_id. 
tv. 
rw source_free_functor. rw id_freecat. 
ap  mor_freecat_id. am. am. am. 
am. 

ir. rwi source_free_functor H6. 
rw target_free_functor. rw fmor_free_functor. 
ap mor_compose_chain. 
apply mor_chain_chain_map with g. am. 
wrr mor_freecat_rw. am. wrr mor_freecat_rw. 

ir. rwi source_free_functor H6. 
rw fmor_free_functor. rw source_compose_chain.

rw fob_free_functor. rw source_chain_map. tv. am. 
rwi mor_freecat_rw H6. 
uh H6; ee. am. am. 
apply mor_chain_chain_map with g. am. wrr mor_freecat_rw. 
am. wrr mor_freecat_rw. 

ir. rwi source_free_functor H6. 
rw fmor_free_functor. rw target_compose_chain.

rw fob_free_functor. rw target_chain_map. tv. am. 
rwi mor_freecat_rw H6. 
uh H6; ee. am. am. 
apply mor_chain_chain_map with g. am. wrr mor_freecat_rw. 
am. wrr mor_freecat_rw. 

ir. rwi source_free_functor H6.
rwi source_free_functor H7.
rw target_free_functor. 
rw fmor_free_functor. rw fmor_free_functor.
rw fmor_free_functor. rw source_free_functor. 
rw comp_freecat. 
rw chain_map_freecat_comp. 
rw compose_chain_freecat_comp. tv. 

apply mor_chain_chain_map with g. am. 
wrr mor_freecat_rw. 
apply mor_chain_chain_map with g. am. 
wrr mor_freecat_rw. 
rw source_chain_map. rw target_chain_map. rww H8. 
am. am. am. am. am. 
rw source_free_functor. rw comp_freecat. 
ap mor_freecat_comp. 
wrr mor_freecat_rw. 
wrr mor_freecat_rw. am. am. am. am. am. 
am. 
wrr mor_freecat_rw. am. wrr mor_freecat_rw.
Qed. 


Lemma fmor_ff_freecat_id : forall g a fo fm x,
free_functor_property g a fo fm ->
inc x (vertices g) ->
fmor (free_functor g a fo fm) (freecat_id x) = id a (fo x).
Proof.
ir. rewrite <- id_freecat with g x. 
rw fmor_id. rw target_free_functor. 
rw fob_free_functor. tv. am. am. 
app free_functor_axioms. rww source_free_functor. 
rww ob_freecat_rw. uh H; ee; am. uh H; ee; am.
rww ob_freecat_rw. uh H; ee; am. 
Qed.

Lemma fmor_ff_freecat_edge : forall g a fo fm u,
free_functor_property g a fo fm ->
inc u (edges g) ->
fmor (free_functor g a fo fm) (freecat_edge u) = fm u.
Proof.
ir. 
rw fmor_free_functor. 
rw chain_map_freecat_edge. rw compose_chain_freecat_edge.
tv. 
uh H; ee. au. 
uh H; ee. au. uh H; ee; au. uh H; ee; am. 
ap mor_freecat_edge. uh H; ee; am. am. 
Qed.

Lemma fmor_comp : forall a f u v,
Functor.axioms f -> source f = a ->
mor a u -> mor a v -> 
source u = target v ->
fmor f (comp a u v) = comp (target f) (fmor f u) (fmor f v).
Proof.
ir. wr H0. 
rww comp_fmor. rww H0. rww H0. 
Qed. 

Lemma fmor_ff_freecat_comp : forall g a fo fm u v,
free_functor_property g a fo fm ->
mor (freecat g) u ->
mor (freecat g) v ->
source u = target v ->
fmor (free_functor g a fo fm) (freecat_comp u v) =
comp a (fmor (free_functor g a fo fm) u) 
(fmor (free_functor g a fo fm) v).
Proof.
ir. cp H. uh H; ee. 
assert (freecat_comp u v = comp (freecat g) u v).
rww comp_freecat. 
rw H9. rw fmor_comp. 
rw target_free_functor. tv. 
app free_functor_axioms. rww source_free_functor. 
am. am. am.  
Qed. 

Lemma fmor_ff_chain_tack : forall g a fo fm u v,
free_functor_property g a fo fm ->
inc u (edges g) -> 
mor (freecat g) v -> source u = target v -> 
fmor (free_functor g a fo fm) (chain_tack u v) =
comp a (fm u) (fmor (free_functor g a fo fm) v).
Proof.
ir. uf chain_tack. 
rw fmor_ff_freecat_comp. rw fmor_ff_freecat_edge. 
tv. am. am. am. 
rww mor_freecat_rw. app mor_freecat_edge. uh H; ee; am.
uh H; ee; am. am. rww source_freecat_edge. 
Qed. 


Lemma free_functor_property_fob_fmor : forall g a f,
Functor.axioms f -> Graph.axioms g ->
source f = freecat g -> target f = a ->
free_functor_property g a (fob f) (fun u => fmor f (freecat_edge u)).
Proof.
ir. 
uhg; ee. 
am. wr H2. rww category_axioms_target. 
ir. wr H2. ap ob_fob. am. 
rw H1. rww ob_freecat_rw. 

ir. wr H2. ap mor_fmor. 
am. rw H1. rww mor_freecat_rw. 
app mor_freecat_edge. 

ir. rw source_fmor. rww source_freecat_edge. am. 
rw H1. rww mor_freecat_rw. 
app mor_freecat_edge. 

ir. rw target_fmor. rww target_freecat_edge. am. 
rw H1. rww mor_freecat_rw. 
app mor_freecat_edge. 
Qed.


Definition graph_fmor g f y := 
fmor (free_functor g (target f) (fob f) 
(fun u => fmor f (freecat_edge u))) y.

Lemma graph_fob : forall g f x,
Graph.axioms g -> source f = freecat g -> 
Functor.axioms f -> inc x (vertices g) ->
fob (free_functor g (target f) (fob f) 
(fun u => fmor f (freecat_edge u))) x = fob f x.
Proof.
ir. rw fob_free_functor. tv. 
ap free_functor_property_fob_fmor. am. am. 
am. tv. am. 
Qed. 

Definition graph_fmor_recovers g f y :=
graph_fmor g f y = fmor f y.

Lemma graph_fmor_recovers_freecat_id : forall g f x,
Graph.axioms g -> source f = freecat g -> 
Functor.axioms f -> inc x (vertices g) ->
graph_fmor_recovers g f (freecat_id x). 
Proof.
ir. uhg. uf graph_fmor. rw fmor_free_functor.
rw chain_map_freecat_id. rw compose_chain_freecat_id. 
assert (freecat_id x = id (source f) x).
rw H0. rww id_freecat. rww ob_freecat_rw. 
rw H3. rww fmor_id. 
rw H0. rww ob_freecat_rw. am. 
app mor_freecat_id. 
Qed. 

Lemma graph_fmor_recovers_freecat_edge : forall g f u,
Graph.axioms g -> source f = freecat g -> 
Functor.axioms f -> inc u (edges g) ->
graph_fmor_recovers g f (freecat_edge u).
Proof.
ir. uhg. uf graph_fmor. rw fmor_free_functor.
rw chain_map_freecat_edge. rw compose_chain_freecat_edge. 
tv. app mor_fmor. rw H0. 
rww mor_freecat_rw. app mor_freecat_edge. 
rww source_fmor. rww source_freecat_edge. 
rw H0. rww mor_freecat_rw. app mor_freecat_edge. 
rww target_fmor. rww target_freecat_edge. 
rw H0. rww mor_freecat_rw. app mor_freecat_edge. 
am. app mor_freecat_edge. 
Qed. 

Lemma graph_fmor_recovers_freecat_comp : forall g f u v,
Graph.axioms g -> source f = freecat g -> 
Functor.axioms f -> mor_freecat g u -> mor_freecat g v ->
source u = target v -> 
graph_fmor_recovers g f u -> graph_fmor_recovers g f v -> 
graph_fmor_recovers g f (freecat_comp u v).
Proof.
ir. uhg. uf graph_fmor. rw fmor_free_functor.
rw chain_map_freecat_comp. rw compose_chain_freecat_comp.

assert (freecat_comp u v = comp (source f) u v).
rw H0. rww comp_freecat. rww mor_freecat_rw. 
rww mor_freecat_rw. rw H7. 
rw fmor_comp. uh H5. uh H6. wr H5; wr H6. 
uf graph_fmor. rww fmor_free_functor. 
rww fmor_free_functor. am. tv. 
rw H0; rww mor_freecat_rw. 
rw H0; rww mor_freecat_rw. am. 
apply mor_chain_chain_map with g. 
app free_functor_property_fob_fmor. 
am. 
apply mor_chain_chain_map with g. 
app free_functor_property_fob_fmor. 
am. 
rw source_chain_map. rw target_chain_map. rww H4. 
am. app mor_freecat_comp. 
Qed. 

Lemma graph_fmor_recovers_chain_tack : forall g f u v,
Graph.axioms g -> source f = freecat g -> 
Functor.axioms f -> inc u (edges g) -> mor_freecat g v ->
source u = target v -> 
graph_fmor_recovers g f v -> 
graph_fmor_recovers g f (chain_tack u v).
Proof.
ir. uf chain_tack. 
app graph_fmor_recovers_freecat_comp. 
app mor_freecat_edge. rww source_freecat_edge. 
app graph_fmor_recovers_freecat_edge. 
Qed. 

Lemma inc_object_number_vertices : forall g u i,
Graph.axioms g -> mor_freecat g u ->
i <= seg_length u -> inc (object_number i u) (vertices g).
Proof.
ir. 
assert (i < seg_length u \/ i = seg_length u). om.
nin H2. assert (object_number i u = source (segment i u)).
rww source_segment. uh H0; ee; am. 
rw H3. uh H0; ee. 
uh H; ee. ap H9. ap H7. am. 
rw H2. rw object_number_seg_length. uh H0; ee. am. 
uh H0; ee; am.  
Qed. 

Lemma mor_freecat_chain_restrict : forall g u i,
Graph.axioms g -> mor_freecat g u ->
i <= seg_length u -> mor_freecat g (chain_restrict i u).
Proof.
ir. 
cp H0; uh H0; ee. 
uhg; ee. am. 
rww source_chain_restrict. 
rww target_chain_restrict. 
app inc_object_number_vertices. 
app arrow_chain_chain_restrict. 

ir. 
rwi seg_length_chain_restrict H7. 
rw segment_chain_restrict. ap H6. om. am. 
Qed. 

Lemma mor_freecat_induction : forall g (P : E -> Prop),
Graph.axioms g -> 
(forall x, inc x (vertices g) -> P (freecat_id x)) ->
(forall u v, inc u (edges g) ->  mor_freecat g v -> 
source u = target v -> P v -> P (chain_tack u v)) ->
(forall u, mor_freecat g u -> P u).
Proof.
ir. 
generalize H2. 
apply arrow_chain_induction with (P:=fun u => mor_freecat g u -> P u).
ir. 
ap H0. uh H3; ee. rwi source_freecat_id H4. am. 

ir. ap H1. assert (u0 = segment (seg_length v) (chain_tack u0 v)).
rww segment_chain_tack_new. rw H7. 
uh H6; ee. ap H11. rw seg_length_chain_tack; om. 
assert (v = chain_restrict (seg_length v) (chain_tack u0 v)).
rw chain_restrict_chain_tack. tv. tv. am. am. 
rw H7. 
ap mor_freecat_chain_restrict. 
am. am. 
rw seg_length_chain_tack. om. am. ap H5. 
assert (v = chain_restrict (seg_length v) (chain_tack u0 v)).
rw chain_restrict_chain_tack. tv. tv. am. am. 
rw H7. 
ap mor_freecat_chain_restrict. 
am. am. 
rw seg_length_chain_tack. om. uh H2; ee; am. 
Qed. 

Lemma graph_fmor_recovers_all : forall g f u,
Graph.axioms g -> source f = freecat g -> 
Functor.axioms f -> mor_freecat g u -> 
graph_fmor_recovers g f u.
Proof.
ir. 
apply mor_freecat_induction with (g:=g)
(P:= graph_fmor_recovers g f).
am. ir. app graph_fmor_recovers_freecat_id. 
ir. app graph_fmor_recovers_chain_tack. 
am.  
Qed. 

Lemma eq_free_functor_fob_fmor : forall g f,
Graph.axioms g -> source f = freecat g -> 
Functor.axioms f ->
f = free_functor g (target f) (fob f) 
(fun u => fmor f (freecat_edge u)).
Proof.
ir. 
ap Functor.axioms_extensionality. 
am. ap free_functor_axioms. 
app free_functor_property_fob_fmor. 
rww source_free_functor. rww target_free_functor.
ir. 
assert (mor_freecat g u). 
wr mor_freecat_rw. wrr H0. am. 
assert (graph_fmor_recovers g f u).
app graph_fmor_recovers_all. 
uh H4; ee. sy; am. 
Qed. 

(** Up to now we have classified functors whose source
is of the form (freecat g). We need to discuss natural
transformations. ***)

Definition free_nt_property g a b (t:E -> E) :=
Graph.axioms g & Functor.axioms a & Functor.axioms b
& source a = freecat g  
& source b = freecat g 
& target a = target b &
(forall x, inc x (vertices g) ->  mor (target a) (t x)) &
(forall x, inc x (vertices g) -> source (t x) = fob a x) &
(forall x, inc x (vertices g) -> target (t x) = fob b x) &
(forall u, inc u (edges g) -> 
comp (target a) (t (target u)) (fmor a (freecat_edge u)) =
comp (target a) (fmor b (freecat_edge u)) (t (source u))).

Definition free_nt_respects a b (t:E->E) u :=
comp (target a) (t (target u)) (fmor a u) =
comp (target a) (fmor b u) (t (source u)).

Lemma free_nt_respects_freecat_id : forall g a b t x,
free_nt_property g a b t -> 
inc x (vertices g) -> 
free_nt_respects a b t (freecat_id x).
Proof.
ir. uh H; ee. uhg. 
assert (freecat_id x = id (source a) x). 
rw H3. rww id_freecat. rww ob_freecat_rw. 

rw H10. rww fmor_id. rww source_id. 
rww target_id. rww right_id. 
rw H3; wr H4. rww fmor_id. 
rw H5. rww left_id. 
app ob_fob. 
rw H4. rww ob_freecat_rw. wr H5; au. 
au. rw H4. rww ob_freecat_rw. 
app ob_fob. rw H3. rww ob_freecat_rw. au. 
au. rw H3. rww ob_freecat_rw.
 rw H3. rww ob_freecat_rw.
 rw H3. rww ob_freecat_rw.
Qed. 

Lemma free_nt_respects_freecat_edge : forall g a b t u,
free_nt_property g a b t -> 
inc u (edges g) -> 
free_nt_respects a b t (freecat_edge u).
Proof.
ir. uh H; ee. 
uhg. 
rw target_freecat_edge. rw source_freecat_edge.
au. 
Qed. 

Lemma free_nt_respects_freecat_comp : forall g a b t u v,
free_nt_property g a b t -> 
mor_freecat g u -> mor_freecat g v -> source u = target v ->
free_nt_respects a b t u -> 
free_nt_respects a b t v -> 
free_nt_respects a b t (freecat_comp u v).
Proof.
ir. uh H; ee. 
uh H3; uh H4. 
assert (freecat_comp u v = comp (source a) u v).
rw H7. rww comp_freecat. 
rww mor_freecat_rw. rww mor_freecat_rw. 
rw H14. 
uhg. 

assert (mor (freecat g) u). 
rww mor_freecat_rw. 
assert (mor (freecat g) v). 
rww mor_freecat_rw. 
assert (mor (source a) u).
rww H7. 
assert (mor (source a) v). 
rww H7. 
assert (mor (source b) u). rww H8. 
assert (mor (source b) v). rww H8. 

assert (inc (target u) (vertices g)).
wr ob_freecat_rw. wr H7. rww ob_target. am. 

assert (inc (target v) (vertices g)).
wr ob_freecat_rw. wr H7. rww ob_target. am. 

assert (inc (source u) (vertices g)).
wr ob_freecat_rw. wr H7. rww ob_source. am. 

assert (inc (source v) (vertices g)).
wr ob_freecat_rw. wr H7. rww ob_source. am. 



rw fmor_comp. 
assert (fmor b (comp (source a) u v) =
fmor b (comp (source b) u v)). 
rw H7; wrr H8. rw H25. 
rww fmor_comp. wr H9. 
rww target_comp. 
rww source_comp. 
rww assoc. 

wr H4. 

wrr assoc. rw H3. 
rw H2. app assoc. 

(** The main step is done but there are 20 subgoals! **)

rw H9. app mor_fmor. 
app H10. app mor_fmor. 
rww source_fmor. rw H2. 
sy; au. rww target_fmor. au. 

au. app mor_fmor. app mor_fmor. 
rww target_fmor. au. rww target_fmor. 
rww source_fmor. rww H2. 
rw H9. app mor_fmor. 
rw H9. app mor_fmor. 
au. rww source_fmor. rww target_fmor. rww H2. 
rww source_fmor. sy; au. am. tv. 
am. am. am. 
Qed.  


Lemma free_nt_respects_chain_tack : forall g a b t u v,
free_nt_property g a b t -> inc u (edges g) -> 
mor_freecat g v -> source u = target v ->
free_nt_respects a b t v -> 
free_nt_respects a b t (chain_tack u v).
Proof.
ir. uf chain_tack. 
apply free_nt_respects_freecat_comp with (g:=g).
am. app mor_freecat_edge. uh H; ee; am. 
am. 
rww source_freecat_edge. 
apply free_nt_respects_freecat_edge with (g:=g).
am. am. am. 
Qed.  

Lemma free_nt_respects_all : forall g a b t u,
free_nt_property g a b t -> 
mor_freecat g u -> 
free_nt_respects a b t u.
Proof.
ir. 
apply mor_freecat_induction with 
(g:=g) (P:= free_nt_respects a b t).
uh H; ee; am. 
ir. apply free_nt_respects_freecat_id with g. am. 
am. 

ir. apply free_nt_respects_chain_tack with g. am. 
am. am. am. am. am. 
Qed. 

Lemma free_nt_nat_trans_property : forall g a b t,
free_nt_property g a b t -> Nat_Trans.property a b t.
Proof.
ir. 
cp H; uh H; ee. 
uhg; ee. 
am. am. rww H4. am. 
ir. wr H5. ap H6. 
wr ob_freecat_rw. wrr H3. am. 
ir. ap H7.  
wr ob_freecat_rw. wrr H3. am. 
ir. ap H8.  
wr ob_freecat_rw. wrr H3. am. 

ir. assert (free_nt_respects a b t u). 
apply free_nt_respects_all with g. 
am. wr mor_freecat_rw. wrr H3. am. 
uh H11. 
wrr H5. 
Qed. 

Lemma free_nt_prop_eq_nat_trans_prop : forall g a b t,
Graph.axioms g -> source a = freecat g -> 
free_nt_property g a b t = Nat_Trans.property a b t.
Proof.
ir. ap iff_eq; ir. 
apply free_nt_nat_trans_property with g.
am. 
uh H1; uhg; ee.
am. am. am. am. wrr H3. am. 
ir. rw H4. ap H5. rw H0. 
rww ob_freecat_rw. 
ir. ap H6. rw H0. 
rww ob_freecat_rw. 
ir. ap H7. rw H0. 
rww ob_freecat_rw. 

ir. rw H4. 
assert (target u = target (freecat_edge u)).
rww target_freecat_edge. 
assert (source u = source (freecat_edge u)). 
rww source_freecat_edge. 
rw H10. rw H11. 
ap H8. rw H0. 
rw mor_freecat_rw. 
app mor_freecat_edge. am. 
Qed. 

Lemma free_nt_property_ntrans : forall g r,
Graph.axioms g -> Nat_Trans.axioms r -> 
osource r = freecat g -> 
free_nt_property g (source r) (target r) (ntrans r).
Proof.
ir. rw free_nt_prop_eq_nat_trans_prop. 
ap Nat_Trans.axioms_property. am. am. 
am.  
Qed. 


(** Note the following lemma which is general for any
natural transformation; in our context it means
that we don't need a specific reconstruction process for
natural transformations from (freecat g) **)

Lemma nat_trans_create_recovers : forall r,
Nat_Trans.axioms r -> 
r = Nat_Trans.create (source r) (target r) (ntrans r).
Proof.
ir. uh H; ee. uh H. sy; am. 
Qed. 

End Free_Category. 





(*****************************************************************************************)
(*****************************************************************************************)
(*****************************************************************************************)
(*****************************************************************************************)

Module Categorical_Relation.

Export Category.
Export Relation.
(** we consider relations which preserve the set of objects
(it might sometime be necessary to generalize but that presents
different difficulties and would require different notation) ***)

Definition cat_rel a r :=
Category.axioms a &
is_relation r &
(forall x  y, related r x y -> mor a x) &
(forall x y, related r x y -> mor a y) &
(forall x y, related r x y -> source x = source y) &
(forall x y, related r x y -> target x = target y).

Definition cat_equiv_rel a r :=
cat_rel a r &
is_equivalence_relation r &
(forall u, mor a u -> related r u u) &
(forall x y u v, related r x y -> related r u v ->
source x = target u ->
related r (comp a x u) (comp a y v)).

Lemma cat_rel_related_rw : forall a r x  y,
cat_rel a r ->
related r x y = 
(related r x y & mor a x & mor a y &
source x = source y & target x = target y).
Proof.
ir. ap iff_eq; ir. 
ee. am. uh H; ee. app (H2 x y). 
uh H; ee. app (H3 x y). 
uh H; ee. app (H4 x y). 
uh H; ee. app (H5 x y). 
ee; am. 
Qed. 

Lemma cer_reflexive : forall a r u,
cat_equiv_rel a r -> mor a u -> related r u u.
Proof.
ir. uh H; ee. au. 
Qed.

Lemma related_comp : forall a r x y u v,
cat_equiv_rel a r -> 
related r x y -> related r u v -> source x = target u ->
related r (comp a x u) (comp a y v).
Proof.
ir. uh H; ee. au. 
Qed. 

Lemma cat_rel_intersection : forall a z,
nonempty z -> 
(forall r, inc r z -> cat_rel a r) ->
cat_rel a (intersection z).
Proof.
ir. uhg; dj. 
nin H. cp (H0 _ H). uh H1; ee. am. 
ap relation_intersection. am. 
ir. cp (H0 _ H2). uh H3; ee; am. 
rwi related_intersection H3. 
nin H. cp (H3 _ H). cp (H0 _ H). 
uh H5; ee. apply H7 with y. am. am. 
rwi related_intersection H4. 
nin H. cp (H4 _ H). cp (H0 _ H). 
uh H6; ee. apply H9 with x. am. am. 
rwi related_intersection H5. 
nin H. cp (H5 _ H). cp (H0 _ H). 
uh H7; ee. au. am. 
rwi related_intersection H6. 
nin H. cp (H6 _ H). cp (H0 _ H). 
uh H8; ee. au. am. 
Qed. 

Lemma cer_intersection : forall a z,
nonempty z -> 
(forall r, inc r z -> cat_equiv_rel a r) ->
cat_equiv_rel a (intersection z).
Proof.
ir. assert (cat_rel a (intersection z)).
ap cat_rel_intersection. am. ir. 
cp (H0 _ H1). uh H2; ee; am. 

uhg; ee. am. 
ap equivalence_relation_intersection. am. 
ir. cp (H0 _ H2). uh H3; ee; am. 
ir. rww related_intersection. ir. 
cp (H0 _ H3). uh H4; ee; au. 

ir. rwi related_intersection H2; 
rwi related_intersection H3; try am. 
rww related_intersection. ir. 
cp (H0 _ H5). 
uh H6; ee; au. 
Qed. 





Definition coarse a :=
Z (Cartesian.product (morphisms a) (morphisms a))
(fun u => (source (pr1 u) = source (pr2 u) & 
target (pr1 u) = target (pr2 u))).

Lemma related_coarse : forall a x y,
Category.axioms a ->
related (coarse a) x y = (mor a x & mor a y & 
source x = source y & target x = target y).
Proof.
ir. 
ap iff_eq; ir. 
ufi coarse H0. uh H0. 
Ztac. rwi pr1_pair H2; rwi pr1_pair H3; rwi pr2_pair H2;
rwi pr2_pair H3. 
cp (product_pr H1). ee. rwi pr1_pair H5. rwi pr2_pair H6. 
ap is_mor_mor. am. am. 
rwi pr1_pair H2; rwi pr1_pair H3; rwi pr2_pair H2;
rwi pr2_pair H3. 
cp (product_pr H1). ee. rwi pr1_pair H5. rwi pr2_pair H6. 
app is_mor_mor. 
 rwi pr1_pair H2; rwi pr1_pair H3; rwi pr2_pair H2;
rwi pr2_pair H3. am. 
rwi pr1_pair H2; rwi pr1_pair H3; rwi pr2_pair H2;
rwi pr2_pair H3. am. 

ee. uf coarse. uhg. ap Z_inc. 
ap product_pair_inc. ap mor_is_mor. am. 
app mor_is_mor. rw pr1_pair. 
rw pr2_pair. ee. am. am. 
Qed. 

Lemma cat_rel_coarse : forall a,
Category.axioms a -> 
cat_rel a (coarse a).
Proof.
ir. uhg; ee. am. 
uhg; ee. ir. 
ufi coarse H0. Ztac. 
cp (product_pr H1). ee. am. 
ir. rwi related_coarse H0; ee. am. am. 
ir. rwi related_coarse H0; ee. am. am. 
ir. rwi related_coarse H0; ee. am. am. 
ir. rwi related_coarse H0; ee. am. am. 
Qed. 

Lemma cat_equiv_rel_coarse : forall a,
Category.axioms a -> 
cat_equiv_rel a (coarse a).
Proof.
ir. 
uhg; dj. ap cat_rel_coarse. am. 
ap show_equivalence_relation.
uh H0; ee; am. 
ir. rwi related_coarse H1. ee. 
rw related_coarse; xd. am. 

ir. rwi related_coarse H1; rwi related_coarse H2. 
rw related_coarse; xd. transitivity (source y).
am. am. 
transitivity (target y); am. am. am. 
am. rw related_coarse; xd. 

rwi related_coarse H3; rwi related_coarse H4. 
 
rw related_coarse; ee. 
rww mor_comp. rww mor_comp. wr H10. 
rww H5. 
rww source_comp. rww source_comp. 
wr H10. rww H5. 
rww target_comp. rww target_comp. 
wr H10. rww H5. am. am. am. am. 
Qed. 

Lemma sub_coarse : forall a r,
cat_rel a r ->
sub r (coarse a).
Proof.
ir. uhg; ir. 
uh H; ee. cp H1. 
uh H6. cp (H6 _ H0).
rwi is_pair_rw H7. rw H7. 
change (related (coarse a) (pr1 x) (pr2 x)). 
assert (related r (pr1 x) (pr2 x)).
uhg. wrr H7. 
rw related_coarse; xd.
apply H2 with (pr2 x). am. 
apply H3 with (pr1 x). am. 
Qed. 

Definition relations_between r s :=
Z (powerset s) (fun y => sub r y).

Lemma inc_relations_between : forall r s y,
is_relation s -> 
inc y (relations_between r s) =
(sub r y & sub y s & is_relation y).
Proof.
ir. ap iff_eq; ir. 
ufi relations_between H0. Ztac. 
rwi powerset_inc_rw H1. am. 
rwi powerset_inc_rw H1. uhg; ir. 
cp (H1 _ H3). ap H. am. ee. 
uf relations_between. ap Z_inc. 
ap powerset_inc. am. am. 
Qed. 


Definition cer a r := 
intersection (Z (relations_between r (coarse a))
(fun y=> cat_equiv_rel a y)).

Lemma cat_equiv_rel_cer : forall a r,
cat_rel a r -> cat_equiv_rel a (cer a r).
Proof.
ir. 
assert (cat_equiv_rel a (coarse a)). 
ap cat_equiv_rel_coarse. uh H; ee; am. 
cp H0. uh H1; ee. 

uf cer. 
ap cer_intersection. 
sh (coarse a). ap Z_inc. 
rw inc_relations_between. ee. 
ap sub_coarse. am. uhg; ir; am. 
uh H1; ee; am. uh H1; ee; am. am. 

ir. Ztac. 
Qed.

Lemma cat_rel_subset : forall a r,
(exists s, (cat_rel a s & sub r s)) ->
cat_rel a r.
Proof.
ir. nin H. ee. 
assert (forall u v, related r u v -> related x u v).
ir. uf related. ap H0. am. 

uh H; ee. 
uhg; ee. am.  uhg; ir. ap H2. app H0. 
ir. apply H3 with y. au. 
ir. apply H4 with x0. au. au. au. 
Qed. 

Lemma sub_cer : forall a r s,
sub r s -> cat_equiv_rel a s ->
sub (cer a r) s.
Proof.
ir. 
assert (cat_rel a r). 
ap cat_rel_subset. sh s. ee; lu. 

uf cer. 
ap intersection_sub. ap Z_inc. 
rw inc_relations_between. ee. am. 
ap sub_coarse. lu. lu. 
assert (cat_equiv_rel a (coarse a)).
app cat_equiv_rel_coarse. 
lu. lu. am. 
Qed.

Lemma cer_contains : forall a r,
cat_rel a r -> sub r (cer a r).
Proof.
ir. 
assert (cat_equiv_rel a (coarse a)).
ap cat_equiv_rel_coarse.
lu. 

uf cer. 
uhg; ir. ap intersection_inc. 
sh (coarse a). 
ap Z_inc.  
rw inc_relations_between. 
ee. ap sub_coarse. am. 
ap sub_coarse. lu. lu. lu. am.
ir. Ztac. rwi inc_relations_between H3.
ee. ap H3. am. lu. 
Qed. 


Definition ker f := 
Z (coarse (source f)) (fun z => (fmor f (pr1 z) = fmor f (pr2 z))).

Lemma related_ker : forall f x y,
Functor.axioms f -> 
related (ker f) x y = 
(mor (source f) x & mor (source f) y & 
source x = source y & target x = target y & fmor f x = fmor f y).
Proof.
ir. 
ap iff_eq; ir. uh H0. 
ufi ker H0. 
assert (related (coarse (source f)) x y).

Ztac. 
assert (fmor f x = fmor f y). Ztac. rwi pr1_pair H3.
rwi pr2_pair H3. am. 

rwi related_coarse H1. xd. lu. 

assert (related (coarse (source f)) x y). 
rw related_coarse. xd. lu. 
uh H1. uhg. uf ker. Ztac. rw pr1_pair. rw pr2_pair. ee; am. 
Qed.

Lemma is_relation_ker : forall f, Functor.axioms f ->
is_relation (ker f).
Proof.
ir. uhg; ir. ufi ker H0; Ztac. 
assert (cat_equiv_rel (source f) (coarse (source f))). 
ap cat_equiv_rel_coarse. 
lu. uh H3. ee. uh H4; ee. ap H4. am. 
Qed. 



Lemma cat_rel_ker : forall a f,
Functor.axioms f -> a = source f ->
cat_rel a (ker f).
Proof.
ir. rw H0. clear H0. clear a. 
uhg; ee. lu. ap is_relation_ker. 
am. 
ir. rwi related_ker H0. ee; am. am. 

ir. rwi related_ker H0. ee; am. am. 

ir. rwi related_ker H0. ee; am. am. 

ir. rwi related_ker H0. ee; am. am. 
Qed.

Lemma cat_equiv_rel_ker : forall a f,
Functor.axioms f -> a = source f ->
cat_equiv_rel a (ker f).
Proof.
ir. rw H0. clear H0. clear a. 
uhg; ee. app cat_rel_ker. 
ap show_equivalence_relation. 
app is_relation_ker. 
ir.  rww related_ker; rwi related_ker H0; try am. xd.

ir. rww related_ker. rwi related_ker H0; try am.
 rwi related_ker H1; try am. xd.
transitivity (source y); au. transitivity (target y); au. 
transitivity (fmor f y); au. 

ir. rww related_ker. ee. am. am. tv. tv. tv. 

ir. rwi related_ker H0; try am. 
rwi related_ker H1; try am.
ee. 
rww related_ker. ee. 
rww mor_comp. rww mor_comp. wr H8. wrr H5. 

rww source_comp. rww source_comp. 
wr H8. wrr H5. 

rww target_comp. rww target_comp. 
wr H8. wrr H5.

wr comp_fmor. 
wr comp_fmor. rw H10. rw H6. tv. am. 
am. am. wr H8. wrr H5.
am. am. am. am. 
Qed. 

Definition compatible r f :=
Functor.axioms f & cat_rel (source f) r &
sub r (ker f).

Lemma compatible_related_ker : forall r f u v,
compatible r f -> related r u v -> related (ker f) u v.
Proof.
ir. 
uh H; ee. uhg. ap H2. am. 
Qed. 

Lemma related_eq_fmor : forall r f u v,
compatible r f -> related r u v -> fmor f u = fmor f v.
Proof.
ir. 
cp (compatible_related_ker H H0). rwi related_ker H1; ee; try am.
lu. 
Qed.

Lemma is_relation_coarse : forall a,
Category.axioms a -> is_relation (coarse a).
Proof.
ir. 
assert (cat_rel a (coarse a)). 
ap cat_rel_coarse. am. lu. 
Qed. 

Lemma compatible_cer : forall a r f, 
compatible r f -> a = source f ->
compatible (cer a r) f.
Proof.
ir. uhg; ee. lu. 
assert (cat_equiv_rel a (cer a r)). 
ap cat_equiv_rel_cer. uh H; ee. rww H0. 
wr H0. lu. 
uf cer. uhg; ir. 
cp (intersection_use_inc H1). ap H2. 
ap Z_inc. 
rw inc_relations_between. 
ee. uh H; ee; am. 
uhg; ir. ufi ker H3. rw H0; Ztac. 
ap is_relation_ker. lu. 
ap is_relation_coarse. 
rw H0; lu. 
ap cat_equiv_rel_ker. lu. am. 
Qed.

Lemma compatible_rw : forall r f,
compatible r f =
(Functor.axioms f & cat_rel (source f) r &
(forall x y, related r x y -> fmor f x = fmor f y)).
Proof.
ir. 
ap iff_eq; ir. 
ee. lu. lu. ir. 
uh H0. uh H; ee. cp (H2 _ H0). 
assert (related (ker f) x y). am. 
rwi related_ker H4. ee; am.
am. 
uhg; ee; try am. 
uhg. ir. 
assert (is_pair x).
uh H0; ee. ap H3. am. 
rwi is_pair_rw H3. rw H3. 
change (related (ker f) (pr1 x) (pr2 x)). 
rwi H3 H2. 
assert (related (coarse (source f)) (pr1 x) (pr2 x)).
assert (sub r (coarse (source f))). ap sub_coarse. 
am. uhg. ap H4. am. 
rwi related_coarse H4. rw related_ker; xd. 
lu. 
Qed. 







End Categorical_Relation.

Module Quotient_Category.
Export Categorical_Relation.


Definition arrow_class r u := Arrow.create (source u) (target u) (class r u).

Lemma source_arrow_class : forall r u,
source (arrow_class r u) = source u.
Proof.
ir. uf arrow_class. rww Arrow.source_create. 
Qed.

Lemma target_arrow_class : forall r u,
target (arrow_class r u) = target u.
Proof.
ir. uf arrow_class. rww Arrow.target_create. 
Qed.

Lemma arrow_arrow_class : forall r u,
arrow (arrow_class r u) = class r u.
Proof.
ir. uf arrow_class. rww Arrow.arrow_create. 
Qed.

Lemma inc_arrow_arrow_class : forall a r u v,
cat_equiv_rel a r -> mor a v ->
inc v (arrow (arrow_class r u)) = related r u v.
Proof.
ir. rw arrow_arrow_class. 
rww inc_class. lu. 
Qed.

Lemma like_arrow_class : forall r u,
Arrow.like (arrow_class r u).
Proof.
ir. uf arrow_class. rww Arrow.create_like. 
Qed.

Definition is_quotient_arrow a r u :=
cat_equiv_rel a r & 
(exists y, mor a y & u = arrow_class r y).

Lemma is_quotient_arrow_arrow_class : forall a r u,
cat_equiv_rel a r -> mor a u -> 
is_quotient_arrow a r (arrow_class r u).
Proof.
ir. uhg; ee. am. sh u. ee; try tv; try am. 
Qed. 

Definition quotient_morphisms a r :=
Image.create (morphisms a) (arrow_class r).

Lemma inc_quotient_morphisms : forall a r u,
cat_equiv_rel a r ->
inc u (quotient_morphisms a r) = is_quotient_arrow a r u.
Proof.
ir. 
uf quotient_morphisms. 
rw Image.inc_rw. ap iff_eq; ir. 
nin H0. ee. 
wr H1. ap is_quotient_arrow_arrow_class. am. ap is_mor_mor.
lu. am. 
uh H0; ee. nin H1. ee. sh x. ee. 
change (is_mor a x). ap mor_is_mor. am. sy; am. 
Qed. 


Lemma related_arrow_class_eq : forall a r u v,
cat_equiv_rel a r ->
mor a u -> 
related r u v =
(arrow_class r u = arrow_class r v).
Proof.
ir. 
ap iff_eq. ir. 
cp H0. assert (source u = source v).
uh H; ee. uh H; ee. au. 
assert (target u = target v).
uh H; ee. uh H; ee. au. 
rwi related_class_eq H1. 
uf arrow_class. rw H3; rw H4; rww H1. 
lu. ap transitive_ap. lu. 
sh v. ee; try am. ap symmetric_ap.
lu. am. 

ir. rw related_class_eq. wr arrow_arrow_class. 
rw H1. rw arrow_arrow_class. tv. lu. 
uh H; ee. au. 
Qed. 

Definition arrow_rep v := rep (arrow v).

Lemma inc_arrow_class_refl : forall a r u,
cat_equiv_rel a r -> mor a u -> inc u (arrow (arrow_class r u)).
Proof.
ir. 
rw arrow_arrow_class. 
rw inc_class. uh H; ee. au. lu. 
Qed. 

Lemma nonempty_arrow : forall a r u,
is_quotient_arrow a r u -> 
nonempty (arrow u).
Proof.
ir. 
uh H; ee. nin H0. ee. rw H1. 
sh x. apply inc_arrow_class_refl with a. am.
am. 
Qed. 

Lemma  inc_arrow_rep_arrow : forall a r u,
is_quotient_arrow a r u -> 
inc (arrow_rep u) (arrow u).
Proof.
ir. 
uf arrow_rep. 
ap nonempty_rep. apply nonempty_arrow with a r. am. 
Qed. 

Lemma related_arrow_rep_arrow_class : forall a r u,
cat_equiv_rel a r -> mor a u -> 
related r u (arrow_rep (arrow_class r u)).
Proof.
ir. 
wr inc_class. 
assert (class r u = arrow (arrow_class r u)).
rw arrow_arrow_class. tv. rw H1. 
apply inc_arrow_rep_arrow with a r. 
ap is_quotient_arrow_arrow_class. am. am. lu. 
Qed. 

Lemma source_arrow_rep : forall a r u,
is_quotient_arrow a r u -> source (arrow_rep u) = source u.
Proof.
ir. uh H; ee. nin H0. ee. 
cp (related_arrow_rep_arrow_class H H0). 
wri H1 H2. 
transitivity (source x). 
uh H; ee. uh H; ee. sy; au. 

rw H1. rw source_arrow_class. tv. 
Qed. 

Lemma target_arrow_rep : forall a r u,
is_quotient_arrow a r u -> target (arrow_rep u) = target u.
Proof.
ir. uh H; ee. nin H0. ee. 
cp (related_arrow_rep_arrow_class H H0). 
wri H1 H2. 
transitivity (target x). 
uh H; ee. uh H; ee. sy; au. 

rw H1. rw target_arrow_class. tv. 
Qed. 

Lemma arrow_class_arrow_rep : forall a r u,
is_quotient_arrow a r u ->
arrow_class r (arrow_rep u) = u. 
Proof. 
ir. 
uh H; ee. nin H0. ee. 
rw H1. sy. 
rewrite <- related_arrow_class_eq with (a:=a). 
apply related_arrow_rep_arrow_class with (a:=a).
am. am. am. am.  
Qed.

Lemma inc_arrow_facts : forall a r u y,
is_quotient_arrow a r u -> inc y (arrow u) ->
(mor a y & source y = source u & target y = target u).
Proof.
ir.
uh H; ee. nin H1. ee. rwi H2 H0. 
rwi arrow_arrow_class H0. rwi inc_class H0. 
uh H; ee. uh H; ee. 
apply H8 with x. am. lu. 

nin H1. ee. rwi H2 H0. 
rwi arrow_arrow_class H0. rwi inc_class H0. 
transitivity (source x). 

uh H; ee. uh H; ee. sy; au. rw H2. 
rww source_arrow_class. lu. 

nin H1. ee. rwi H2 H0. 
rwi arrow_arrow_class H0. rwi inc_class H0. 
transitivity (target x). 

uh H; ee. uh H; ee. sy; au. rw H2. 
rww target_arrow_class. lu. 
Qed. 

Lemma mor_arrow_rep : forall a r u,
is_quotient_arrow a r u ->
mor a (arrow_rep u).
Proof.
ir. 
uh H; ee. 
nin H0; ee. rw H1. 
cp (related_arrow_rep_arrow_class H H0). 
uh H; ee. 
uh H; ee. apply H8 with x. am. 
Qed.

Lemma related_arrow_rep : forall a r u v,
cat_equiv_rel a r -> mor a v -> u = arrow_class r v ->
related r v (arrow_rep u).
Proof.
ir. rw H1. 
apply related_arrow_rep_arrow_class with a. am. am. 
Qed. 


Lemma related_arrow_rep_rw : forall a r u v,
cat_equiv_rel a r -> is_quotient_arrow a r u -> mor a v -> 
related r v (arrow_rep u) = (u = arrow_class r v).
Proof.
ir. 
ap iff_eq; ir. 
cp H0. uh H3; ee. nin H4. ee. rw H5. 
rewrite <- related_arrow_class_eq with (a:=a). 
ap transitive_ap. lu. 
sh (arrow_rep u). ee. rw H5. 
apply related_arrow_rep_arrow_class with a. am. 
am. ap symmetric_ap. lu. am. 
am. am. rw H2. 
apply related_arrow_rep_arrow_class with a. am. 
am. 
Qed. 


Definition quot_id a r x :=
arrow_class r (id a x).

Definition quot_comp a r u v :=
arrow_class r (comp a (arrow_rep u) (arrow_rep v)).

Lemma source_quot_id : forall a r x,
ob a x -> 
source (quot_id a r x) = x.
Proof.
ir. uf quot_id. 
rw source_arrow_class. rww source_id. 
Qed.

Lemma target_quot_id : forall a r x,
ob a x -> 
target (quot_id a r x) = x.
Proof.
ir. uf quot_id. 
rw target_arrow_class. rww target_id. 
Qed.

Lemma source_quot_comp : forall a r u v,
cat_equiv_rel a r ->
is_quotient_arrow a r u ->
is_quotient_arrow a r v -> source u = target v ->
source (quot_comp a r u v) = source v.
Proof.
ir. 
uf quot_comp. 
rw source_arrow_class. rw source_comp. 
rewrite source_arrow_rep with (a:=a)(r:=r). tv.
am. 
apply mor_arrow_rep with r. am. 
apply mor_arrow_rep with r. am. 
rewrite source_arrow_rep with (a:=a)(r:=r). 
rewrite target_arrow_rep with (a:=a)(r:=r). 
am. am. am. 
Qed. 

Lemma target_quot_comp : forall a r u v,
cat_equiv_rel a r ->
is_quotient_arrow a r u ->
is_quotient_arrow a r v -> source u = target v ->
target (quot_comp a r u v) = target u.
Proof.
ir. 
uf quot_comp. 
rw target_arrow_class. rw target_comp. 
rewrite target_arrow_rep with (a:=a)(r:=r). tv.
am. 
apply mor_arrow_rep with r. am. 
apply mor_arrow_rep with r. am. 
rewrite source_arrow_rep with (a:=a)(r:=r). 
rewrite target_arrow_rep with (a:=a)(r:=r). 
am. am. am. 
Qed. 

Lemma is_quotient_arrow_quot_id : forall a r x,
cat_equiv_rel a r -> ob a x ->
is_quotient_arrow a r (quot_id a r x).
Proof.
ir. 
uf quot_id. 
ap is_quotient_arrow_arrow_class. am. 
app mor_id. 
Qed.

Lemma is_quotient_arrow_quot_comp : forall a r u v,
cat_equiv_rel a r -> is_quotient_arrow a r u -> is_quotient_arrow a r v 
-> source u = target v ->
is_quotient_arrow a r (quot_comp a r u v).
Proof.
ir. uf quot_comp. 
ap is_quotient_arrow_arrow_class.
am. 
rww mor_comp. 
apply mor_arrow_rep with r. am. 
apply mor_arrow_rep with r. am.
rewrite source_arrow_rep with (a:=a)(r:=r). 
rewrite target_arrow_rep with (a:=a)(r:=r). 
am. am. am. 
Qed. 

Lemma arrow_class_eq : forall a r u v,
cat_equiv_rel a r -> mor a u ->  
(arrow_class r u = arrow_class r v) = 
(related r u v).
Proof.
ir. 
sy. ap (related_arrow_class_eq (a:=a)). am. am. 
Qed.  

Lemma arrow_class_id : forall a r x,
arrow_class r (id a x) = quot_id a r x.
Proof.
ir. tv. 
Qed. 

Lemma quot_comp_arrow_class : forall a r u v,
cat_equiv_rel a r -> mor a u -> mor a v -> source u = target v ->
quot_comp a r (arrow_class r u) (arrow_class r v) = 
arrow_class r (comp a u v).
Proof.
ir. 
uf quot_comp. 
rewrite arrow_class_eq with (a:=a). 
ap related_comp. am. 
ap symmetric_ap. lu. 
ap (related_arrow_rep_arrow_class (a:=a)). 
am. am. 
ap symmetric_ap. lu. 
ap (related_arrow_rep_arrow_class (a:=a)). 
am. am. 

rewrite source_arrow_rep with (a:=a)(r:=r). 
rewrite target_arrow_rep with (a:=a)(r:=r). 
rw source_arrow_class. 
rww target_arrow_class. 

app is_quotient_arrow_arrow_class. 
app is_quotient_arrow_arrow_class. 
am. 

rw mor_comp. tv. 
ap (mor_arrow_rep (a:=a)(r:=r)). 
app is_quotient_arrow_arrow_class. 
ap (mor_arrow_rep (a:=a)(r:=r)). 
app is_quotient_arrow_arrow_class. 

rewrite source_arrow_rep with (a:=a)(r:=r). 
rewrite target_arrow_rep with (a:=a)(r:=r). 
rw source_arrow_class. 
rww target_arrow_class. 

app is_quotient_arrow_arrow_class. 
app is_quotient_arrow_arrow_class. 
tv. 
Qed. 


Lemma quot_id_left : forall a r a' r' x u,
cat_equiv_rel a r -> is_quotient_arrow a r u ->
x = target u -> a' = a -> r' = r ->
quot_comp a r (quot_id a' r' x) u = u.
Proof.
ir. 
rw H2; rw H3. 

uh H0; ee. nin H4; ee. rw H5. 
uf quot_id. 

assert (target u = target x0). 
rw H5. 
rewrite target_arrow_class. tv. 
assert (ob a x). 
rw H1; rw H6; rww ob_target. 


rw quot_comp_arrow_class. 
rw left_id. tv. rw H1. wrr H1. 
am. wr H6; sy; am. tv. 
am. app mor_id. am. 
rww source_id. wrr H6. 
Qed. 

Lemma quot_id_right : forall a r a' r' x u,
cat_equiv_rel a r -> is_quotient_arrow a r u ->
x = source u -> a' = a -> r' = r ->
quot_comp a r u (quot_id a' r' x) = u.
Proof.
ir. 
rw H2; rw H3. 

uh H0; ee. nin H4; ee. rw H5. 
uf quot_id. 

assert (source u = source x0). 
rw H5. 
rewrite source_arrow_class. tv. 
assert (ob a x). 
rw H1; rw H6; rww ob_source. 


rw quot_comp_arrow_class. 
rw right_id. tv. rw H1. wrr H1. 
am. wr H6; sy; am. tv. 
am. am. app mor_id. 
rww target_id. wrr H6. sy; am. 
Qed. 

Lemma quot_comp_assoc : forall a r a' r' u v w,
cat_equiv_rel a r ->  is_quotient_arrow a r u -> is_quotient_arrow a r v 
-> is_quotient_arrow a r w -> source u = target v ->
source v = target w -> a' = a -> r' = r -> 
quot_comp a r (quot_comp a' r' u v) w = quot_comp a r u (quot_comp a' r' v w).
Proof.
ir. rw H5; rw H6. clear H5 H6. 

uh H0; uh H1; uh H2; ee. 
nin H7; nin H6; nin H5; ee.
clear H0 H1 H2. 


assert (source x = target x0). 
transitivity (source u). 
rw H10. 
rww source_arrow_class. 
rw H3. rw H9. rww target_arrow_class. 

assert (source x0 = target x1). 
transitivity (source v). 
rw H9. 
rww source_arrow_class. 
rw H4. rw H8. rww target_arrow_class. 


rw H10; rw H9; rw H8. 
rw quot_comp_arrow_class. 
rw quot_comp_arrow_class. 
rw quot_comp_arrow_class.
rw quot_comp_arrow_class.
rw assoc. reflexivity. 

am. am. am. am. am. 
tv. am. am. 
rww mor_comp. 
rww target_comp. am. am. 
am. am. am. rww mor_comp. am. 
rww source_comp. am. am. 
am. am. 
Qed. 

Definition quotient_cat a r := Category.Notations.create (objects a) 
(quotient_morphisms a r) (quot_comp a r) (quot_id a r) (structure a).

Lemma is_ob_quotient_cat : forall a r x,
is_ob (quotient_cat a r) x = is_ob a x.
Proof.
ir. uf quotient_cat. 
rw is_ob_create. tv. 
Qed. 

Lemma is_mor_quotient_cat : forall a r u,
cat_equiv_rel a r -> 
is_mor (quotient_cat a r) u = is_quotient_arrow a r u.
Proof.
ir. 
uf quotient_cat. rw is_mor_create. 
rww inc_quotient_morphisms. 
Qed.

Lemma comp_quotient_cat : forall a r u v,
cat_equiv_rel a r -> is_quotient_arrow a r u -> is_quotient_arrow a r v ->
source u = target v -> comp (quotient_cat a r) u v = quot_comp a r u v.
Proof.
ir. 
uf quotient_cat. 
rw comp_create. tv. 
rww inc_quotient_morphisms. 
rww inc_quotient_morphisms. am. 
Qed. 

Lemma id_quotient_cat : forall a r x,
cat_equiv_rel a r -> ob a x -> 
id (quotient_cat a r) x = quot_id a r x.
Proof.
ir. uf quotient_cat. rw id_create. tv. 
ap ob_is_ob. am. 
Qed. 


Lemma quotient_cat_axioms : forall a r,
cat_equiv_rel a r ->
Category.axioms (quotient_cat a r).
Proof.
ir. 
uhg; dj. 
ir. ap iff_eq; ir. cp H0. 
rwi is_ob_quotient_cat H0. 
assert (ob a x). ap is_ob_ob. uh H; ee. uh H; ee; am. 
am. 
uhg; ee. am. 
rw is_mor_quotient_cat. 
rw id_quotient_cat. 
ap is_quotient_arrow_quot_id. am. am. am. 
am. am. rw id_quotient_cat. 
rww source_quot_id. am. am. 
rww id_quotient_cat. rww target_quot_id. 
ir. rwi is_mor_quotient_cat H3. 
rw id_quotient_cat. 
rw comp_quotient_cat. rw quot_id_right. 
tv. am. am. sy; am. tv. tv. am. am. 
app is_quotient_arrow_quot_id. 
rww target_quot_id. am. am. am. 
ir. rwi is_mor_quotient_cat H3. 
rw id_quotient_cat. 
rw comp_quotient_cat. rw quot_id_left. 
tv. am. am. sy; am. tv. tv. am. 
app is_quotient_arrow_quot_id. am. 
rww source_quot_id. sy; am. am. am. 
am. uh H0; ee; am. 


ir. ap iff_eq; ir. 
rwi is_mor_quotient_cat H1. 
uhg; dj. rw is_mor_quotient_cat. am. 
am. rw is_ob_quotient_cat. 
uh H1; ee. nin H3. ee. rw H4. 
rw source_arrow_class. ap ob_is_ob. 
rww ob_source. 
 rw is_ob_quotient_cat. 
uh H1; ee. nin H4. ee. rw H5. 
rw target_arrow_class. ap ob_is_ob. 
rww ob_target. 
rwi H0 H4. uh H4; ee. 
ap H9. am. tv. 
rwi H0 H3. uh H3; ee. 
ap H9. am. tv. 
uh H1. ee. nin H7. ee. rw H8. 
uf arrow_class. 
rww Arrow.create_like. am. uh H1; ee. am. 

ap iff_eq; ir. uh H2; ee. 
cp H2; cp H3. rwi is_mor_quotient_cat H2.
rwi is_mor_quotient_cat H3. 

uhg; ee. uhg; ee; am. 
rw is_mor_quotient_cat. 
rw comp_quotient_cat. 
ap is_quotient_arrow_quot_comp. am. 
am. am. am. am. am. am. am. 
am. rw comp_quotient_cat. 
rw source_quot_comp. tv. 
am. am. am. am. am. 
am. am. am. 
rw comp_quotient_cat. 
rw target_quot_comp. tv. 
am. am. am. am. am. 
am. am. am. am. am. 
uh H2; ee; am. 


uh H3; uh H4; ee. 
rwi is_mor_quotient_cat H3. 
rwi is_mor_quotient_cat H7. 
rwi is_mor_quotient_cat H5. 

rw comp_quotient_cat. 
rw comp_quotient_cat. 
rw comp_quotient_cat. 
rw comp_quotient_cat. 

rw quot_comp_assoc. reflexivity. 
am. am. am. am. am. 
am. tv. tv. am. am. am. am. 
am. am. 
rw comp_quotient_cat. 
app is_quotient_arrow_quot_comp. 
am. am. am. 
am. 
rww comp_quotient_cat. rww target_quot_comp. 
am. am. am. am. am. 
rw comp_quotient_cat. 
app is_quotient_arrow_quot_comp. 
am. am. am. 
am. am. 
rww comp_quotient_cat. rww source_quot_comp. 
am. am. am. 

uf quotient_cat. 
ap Category.Notations.create_like. 
Qed. 

Lemma ob_quotient_cat : forall a r x,
cat_equiv_rel a r -> 
ob (quotient_cat a r) x = ob a x.
Proof.
ir. 
ap iff_eq; ir. uh H0; ee. 
rwi is_ob_quotient_cat H1. ap is_ob_ob. 
uh H; ee; uh H; ee; am. am. 
uhg; ee. ap quotient_cat_axioms. am. 
rw is_ob_quotient_cat. app ob_is_ob. 
Qed.

Lemma mor_quotient_cat : forall a r u,
cat_equiv_rel a r ->
mor (quotient_cat a r) u = is_quotient_arrow a r u.
Proof. 
ir. 
ap iff_eq; ir. uh H0; ee. 
rwi is_mor_quotient_cat H1. am. am. 
uhg; ee. ap quotient_cat_axioms. am. 
rww is_mor_quotient_cat. 
Qed. 

Lemma mor_quotient_cat_ex : forall a r u,
cat_equiv_rel a r ->
mor (quotient_cat a r) u = 
(exists y, mor a y & u = arrow_class r y).
Proof.
ir. rww mor_quotient_cat. 
ap iff_eq; ir. uh H0; ee. am. uhg; ee. 
am. am. 
Qed.

Lemma mor_quotient_cat_quot_id : forall a r x,
cat_equiv_rel a r -> ob a x -> 
mor (quotient_cat a r) (quot_id a r x).
Proof.
ir. rw mor_quotient_cat.
app is_quotient_arrow_quot_id. am. 
Qed.

Lemma mor_quotient_cat_quot_comp : forall a r u v,
cat_equiv_rel a r ->
mor (quotient_cat a r) u ->
mor (quotient_cat a r) v ->
source u = target v ->
mor (quotient_cat a r) (quot_comp a r u v).
Proof.
ir. 
rwi mor_quotient_cat H0. 
rwi mor_quotient_cat H1. 
rw mor_quotient_cat. 
ap is_quotient_arrow_quot_comp. am. 
am. am. am. am. am. am. 
Qed. 

Lemma mor_quotient_cat_arrow_class : forall a r u,
cat_equiv_rel a r -> mor a u ->
mor (quotient_cat a r) (arrow_class r u).
Proof.
ir. rw mor_quotient_cat. 
ap is_quotient_arrow_arrow_class. am. am. am. 
Qed. 

(** next quotient_functor is the projection to the 
quotient and quotient_dotted is the factorizing functor
for the universal property. *********************)



End Quotient_Category.

Module Quotient_Functor.
Export Quotient_Category.


(** try something strange here: make it depend on fo even though
it doesnt, so we can do rewriting ***)

Definition qfunctor a b r (fo fm:E-> E) :=
Functor.create a (quotient_cat b r) (fun u => arrow_class r (fm u)).

Lemma source_qfunctor : forall a b r fo fm,
source (qfunctor a b r fo fm) = a.
Proof.
ir. uf qfunctor. rw Functor.source_create. tv. 
Qed.

Lemma target_qfunctor : forall a b r fo fm,
target (qfunctor a b r fo fm) = (quotient_cat b r).
Proof.
ir. uf qfunctor. rw Functor.target_create. tv. 
Qed.

Lemma fmor_qfunctor : forall a b r fo fm u,
mor a u -> 
fmor (qfunctor a b r fo fm) u = arrow_class r (fm u).
Proof.
ir. uf qfunctor. rw fmor_create. tv. am. 
Qed.

Definition qfunctor_property a b r fo fm :=
Category.axioms a &
cat_equiv_rel b r &
(forall x, ob a x -> ob b (fo x)) &
(forall u, mor a u -> mor b (fm u)) &
(forall u, mor a u -> source (fm u) = fo (source u)) &
(forall u, mor a u -> target (fm u) = fo (target u)) &
(forall x, ob a x -> related r (fm (id a x)) (id b (fo x))) &
(forall u v, mor a u -> mor a v -> source u = target v ->
related r (fm (comp a u v)) (comp b (fm u) (fm v))).

Lemma fob_qfunctor : forall a b r fo fm x,
qfunctor_property a b r fo fm -> ob a x ->
fob (qfunctor a b r fo fm) x = fo x.
Proof.
ir. 
uf fob. rw fmor_qfunctor. rw source_arrow_class. 
rw source_qfunctor. uh H; ee. 
rw H4. rww source_id. app mor_id. 
rw source_qfunctor. app mor_id. 
Qed. 

Lemma ob_fob_qfunctor : forall a b r fo fm x, 
qfunctor_property a b r fo fm -> ob a x ->
ob (quotient_cat b r) (fob (qfunctor a b r fo fm) x).
Proof.
ir. 
rww fob_qfunctor. 
rw ob_quotient_cat. uh H; ee; au. uh H; ee; am. 
Qed.

Lemma mor_fmor_qfunctor : forall a b r fo fm u, 
qfunctor_property a b r fo fm -> mor a u ->
mor (quotient_cat b r) (fmor (qfunctor a b r fo fm) u).
Proof.
ir. 
rww fmor_qfunctor. rww mor_quotient_cat. 
ap is_quotient_arrow_arrow_class. lu. 
uh H; ee; au. lu. 
Qed.

Lemma source_fmor_qfunctor : forall a b r fo fm u,
qfunctor_property a b r fo fm -> mor a u ->
source (fmor (qfunctor a b r fo fm) u) = fob (qfunctor a b r fo fm) (source u).
Proof.
ir. 
rw fmor_qfunctor. rw source_arrow_class.
rww fob_qfunctor. uh H; ee; au. rww ob_source. am. 
Qed. 

Lemma target_fmor_qfunctor : forall a b r fo fm u,
qfunctor_property a b r fo fm -> mor a u ->
target (fmor (qfunctor a b r fo fm) u) = fob (qfunctor a b r fo fm) (target u).
Proof.
ir. 
rw fmor_qfunctor. rw target_arrow_class.
rww fob_qfunctor. uh H; ee; au. rww ob_target. am. 
Qed. 

Lemma fmor_qfunctor_id : forall a b r fo fm x, 
qfunctor_property a b r fo fm -> ob a x ->
fmor (qfunctor a b r fo fm) (id a x) = 
id (quotient_cat b r) (fob (qfunctor a b r fo fm) x).
Proof.
ir. rw fmor_qfunctor. 
rw id_quotient_cat. 
rw fob_qfunctor. uf quot_id. 
rewrite <- related_arrow_class_eq with (a:=b). 
uh H; ee; au. lu. 
assert (mor a (id a x)). app  mor_id. 
uh H; ee; au. am. am. lu. 
rww fob_qfunctor. uh H; ee; au. app mor_id. 
Qed.

Lemma fmor_qfunctor_comp : forall a b r fo fm u v,
qfunctor_property a b r fo fm -> mor a u ->
mor a v -> source u = target v ->
fmor (qfunctor a b r fo fm) (comp a u v) =
comp (quotient_cat b r) (fmor (qfunctor a b r fo fm) u) 
(fmor (qfunctor a b r fo fm) v).
Proof.
ir. 
assert (cat_equiv_rel b r). lu. 
rww fmor_qfunctor. rww fmor_qfunctor. 
rww fmor_qfunctor. 
rw comp_quotient_cat. 
rw quot_comp_arrow_class. 
rewrite <- related_arrow_class_eq with (a:=b). 
uh H; ee; au. am. 
assert (mor a (comp a u v)). 
rww mor_comp. 
uh H; ee; au. am. 
uh H; ee; au. 
uh H; ee; au. 
uh H; ee. rww H7; rww H8. rww H2. 
am. 
app is_quotient_arrow_arrow_class. 
uh H; ee; au. 
app is_quotient_arrow_arrow_class. 
uh H; ee; au. 
rw source_arrow_class. rw target_arrow_class.
uh H; ee. rww H7; rww H8. rww H2. 
rww mor_comp. 
Qed.

Lemma qfunctor_axioms : forall a b r fo fm,
qfunctor_property a b r fo fm -> 
Functor.axioms (qfunctor a b r fo fm).
Proof.
ir. 
uhg; ee. 
uf qfunctor. uf Functor.create. 
ap Umorphism.create_like. 
rw source_qfunctor. lu. 
rw target_qfunctor. ap quotient_cat_axioms. 
lu. 

ir. rwi source_qfunctor H0. 
rw target_qfunctor. app ob_fob_qfunctor. 

ir. rwi source_qfunctor H0. 
rw target_qfunctor. 
rw source_qfunctor. 
sy; app fmor_qfunctor_id. 

ir. rwi source_qfunctor H0. 
rw target_qfunctor. 
app  mor_fmor_qfunctor. 

ir. rwi source_qfunctor H0. 
rww source_fmor_qfunctor. 

ir. rwi source_qfunctor H0. 
rww target_fmor_qfunctor. 

ir. rwi source_qfunctor H0. 
rwi source_qfunctor H1. 
rw target_qfunctor. 
rw source_qfunctor. 
sy; app fmor_qfunctor_comp. 
Qed. 

Lemma qfunctor_extensionality : forall a b r fo fm a' b' r' fo' fm',
a = a' -> b = b' -> r = r' ->
qfunctor_property a b r fo fm -> 
qfunctor_property a' b' r' fo' fm' ->
(forall u, mor a u -> related r (fm u) (fm' u)) -> 
qfunctor a b r fo fm = qfunctor a' b' r' fo' fm'.
Proof.
ir. 
ap Functor.axioms_extensionality. 
app qfunctor_axioms. app qfunctor_axioms. 
rw source_qfunctor. rww source_qfunctor. 
rw target_qfunctor. rw target_qfunctor. 
rw H0; rww H1. 

ir. rwi source_qfunctor H5. 
rw fmor_qfunctor. rw fmor_qfunctor. 
wr H1. rewrite <- related_arrow_class_eq with (a:=b). 
au. uh H2; ee; am. 
uh H2; ee; au. wrr H. am. 
Qed. 

Lemma eq_qfunctor : forall a b r f fo fm,
Functor.axioms f -> source f = a ->
target f = (quotient_cat b r) -> 
qfunctor_property a b r fo fm ->
(forall u, mor a u -> related r (fm u) (arrow_rep (fmor f u))) ->
f = qfunctor a b r fo fm.
Proof.
ir. 
ap Functor.axioms_extensionality. am. 
ap qfunctor_axioms. am. 
rw source_qfunctor. am. 
rw target_qfunctor. am. 
ir. rw fmor_qfunctor. 
assert (is_quotient_arrow b r (fmor f u)).
wr mor_quotient_cat. wr H1. app mor_fmor. 
lu. uh H5; ee. nin H6; ee. rw H7. 
rewrite <- related_arrow_class_eq with (a:=b). 
ap transitive_ap. lu. 
sh (arrow_rep (fmor f u)). 
ee. rw H7. 
apply related_arrow_rep_arrow_class with (a:=b).
lu. am. 
ap symmetric_ap. lu. ap H3. wrr H0. 
lu. am. wrr H0.  
Qed.

Lemma qfunctor_property_fob_fmor : forall b r f,
Functor.axioms f ->
cat_equiv_rel b r -> target f = (quotient_cat b r) -> 
qfunctor_property (source f) b r (fob f) (fun u => arrow_rep (fmor f u)).
Proof.
ir. 
uhg; ee. uh H; ee. am. 
am. 
ir. assert (ob (target f) (fob f x)). 
app ob_fob. rwi H1 H3. 
rwi ob_quotient_cat H3. am. am. 

ir. apply mor_arrow_rep with (r:=r). 
wr mor_quotient_cat. wr H1. app mor_fmor. 
am. 

ir. rewrite source_arrow_rep with (a:=b) (r:=r). 
rw source_fmor. tv. am. am. 
wr mor_quotient_cat. wr H1. app mor_fmor. 
am. 

ir. rewrite target_arrow_rep with (a:=b) (r:=r). 
rw target_fmor. tv. am. am. 
wr mor_quotient_cat. wr H1. app mor_fmor. 
am. 

ir. 
assert (ob b (fob f x)). 
assert (ob (target f) (fob f x)). 
app ob_fob. rwi H1 H3. 
rwi ob_quotient_cat H3. am. am. 
 
rw fmor_id. 
rw H1. rw id_quotient_cat. 
rewrite related_arrow_class_eq with (a:=b). 
rewrite arrow_class_arrow_rep with (a:=b). 
tv. 
app is_quotient_arrow_quot_id. am. 
apply mor_arrow_rep with (r:=r). 
app is_quotient_arrow_quot_id. am. 
am. am. tv. am. 

ir. 
assert (is_quotient_arrow b r (fmor f u)). 
wr mor_quotient_cat. wr H1. app mor_fmor. am. 
assert (is_quotient_arrow b r (fmor f v)). 
wr mor_quotient_cat. wr H1. app mor_fmor. am. 

rewrite related_arrow_class_eq with (a:=b). 
rewrite arrow_class_arrow_rep with (a:=b). 

wr comp_fmor. 
rw H1. rw comp_quotient_cat. reflexivity. 
am. am. am. rw source_fmor. rw target_fmor. rww H4. 
am. am. am. am. am. am. am. am. 
wr mor_quotient_cat. wr H1. ap mor_fmor. am. 
rww mor_comp. am. am. 

 
apply mor_arrow_rep with (r:=r). 
wr mor_quotient_cat. wr H1. ap mor_fmor. am. 
rww mor_comp. am. 
Qed.

Lemma eq_qfunctor2 : forall b r f,
Functor.axioms f ->
cat_equiv_rel b r -> target f = (quotient_cat b r) -> 
f = qfunctor (source f) b r (fob f) (fun u => arrow_rep (fmor f u)).
Proof.
ir. ap eq_qfunctor. am. tv. am. 
ap qfunctor_property_fob_fmor. am. am. am. 

ir. uh H0; ee. ap H4. 
apply mor_arrow_rep with (r:=r). 
wr mor_quotient_cat. wr H1. ap mor_fmor. am. 
am. uhg; ee; am. 
Qed.



Definition qprojection a r :=
qfunctor a a r (fun (x:E) => x) (fun (u:E)=> u).

Lemma source_qprojection : forall a r,
source (qprojection a r) = a.
Proof.
ir. uf qprojection. rww source_qfunctor. 
Qed.

Lemma target_qprojection : forall a r,
target (qprojection a r) = (quotient_cat a r).
Proof.
ir. uf qprojection. rww target_qfunctor. 
Qed.

Lemma qprojection_property : forall a r,
cat_equiv_rel a r ->
qfunctor_property a a r (fun (x:E) => x) (fun (u:E)=> u).
Proof.
ir. uhg; ee. 
lu. am. 
ir; tv. ir; tv. 
ir; tv. ir; tv. 
ir. uh H; ee. ap H2. app mor_id. 

ir. uh H; ee. ap H4. rww mor_comp. 
Qed.

Lemma fob_qprojection : forall a r x,
cat_equiv_rel a r -> ob a x ->
fob (qprojection a r) x = x.
Proof.
ir. uf qprojection. rww fob_qfunctor. 
app qprojection_property. 
Qed.

Lemma fmor_qprojection : forall a r u,
mor a u ->
fmor (qprojection a r) u = (arrow_class r u).
Proof.
ir. uf qprojection. rw fmor_qfunctor. 
tv. am. 
Qed.

Lemma fmor_qprojection_arrow_rep : forall a r u,
is_quotient_arrow a r u -> 
fmor (qprojection a r) (arrow_rep u) = u.
Proof.
ir. rw fmor_qprojection. 
rewrite arrow_class_arrow_rep with (a:=a). tv. am. 
apply mor_arrow_rep with (a:=a)(r:=r). am. 
Qed. 

Lemma qprojection_axioms : forall a r,
cat_equiv_rel a r ->
Functor.axioms (qprojection a r).
Proof.
ir. uf qprojection. 
ap qfunctor_axioms. app qprojection_property. 
Qed.


Definition qdotted r f :=
Functor.create (quotient_cat (source f) r) (target f) 
(fun u => fmor f (arrow_rep u)).

Lemma source_qdotted : forall r f,
source (qdotted r f) = quotient_cat (source f) r.
Proof.
ir. uf qdotted. 
rww Functor.source_create. 
Qed.

Lemma target_qdotted :  forall r f,
target (qdotted r f) = target f.
Proof.
ir. uf qdotted. 
rww Functor.target_create. 
Qed.


Lemma fmor_qdotted : forall r f u,
cat_equiv_rel (source f) r 
-> is_quotient_arrow (source f) r u -> 
fmor (qdotted r f) u = fmor f (arrow_rep u).
Proof.
ir. uf qdotted. 
rw Functor.fmor_create. tv. 
rww mor_quotient_cat.  
Qed.

Lemma fmor_qdotted_arrow_class : forall r f u,
cat_equiv_rel (source f) r  -> 
compatible r f -> mor (source f) u ->
fmor (qdotted r f) (arrow_class r u) = fmor f u.
Proof.
ir. 
rw fmor_qdotted. 
rwi compatible_rw H0. ee. sy; ap H3. 
apply related_arrow_rep_arrow_class with (a:= source f). 
am. am. am. 
app is_quotient_arrow_arrow_class. 
Qed. 

Lemma fob_qdotted : forall r f x,
cat_equiv_rel (source f) r  -> 
compatible r f -> ob (source f) x ->
fob (qdotted r f) x = fob f x.
Proof.
ir. uf fob. 
rw source_qdotted. 
rw id_quotient_cat. 
uf quot_id. 
rw fmor_qdotted_arrow_class. 
tv. am. am. app mor_id. am. am. 
Qed.

Lemma fmor_qdotted_quot_id : forall r f x,
cat_equiv_rel (source f) r  -> 
compatible r f -> ob (source f) x ->
fmor (qdotted r f) (quot_id (source f) r x) = id (target f) (fob f x).
Proof.
ir. 
uf quot_id. rw fmor_qdotted_arrow_class. 
rw fmor_id. tv. uh H0; ee; am. tv. 
am. am. am. app mor_id. 
Qed. 

Lemma fmor_qdotted_quot_comp : forall r f u v,
cat_equiv_rel (source f) r  -> 
compatible r f -> is_quotient_arrow (source f) r u ->
is_quotient_arrow (source f) r v -> source u = target v ->
fmor (qdotted r f) (quot_comp (source f) r u v) =
comp (target f) (fmor (qdotted r f) u) (fmor (qdotted r f) v).
Proof.
ir. 
uf quot_comp. 
rww fmor_qdotted_arrow_class. 
wr comp_fmor. 
rww fmor_qdotted. rww fmor_qdotted. 
uh H0; ee; am. 
apply mor_arrow_rep with (r:=r). 
am. 
apply mor_arrow_rep with (r:=r). 
am. 
rewrite source_arrow_rep with (a:=source f) (r:=r).
rewrite target_arrow_rep with (a:=source f) (r:=r).
am. am. am. 
rww mor_comp. 
apply mor_arrow_rep with (r:=r). 
am. 
apply mor_arrow_rep with (r:=r). 
am. 
rewrite source_arrow_rep with (a:=source f) (r:=r).
rewrite target_arrow_rep with (a:=source f) (r:=r).
am. am. am. 
Qed. 

Lemma qdotted_axioms : forall r f,
cat_equiv_rel (source f) r  -> 
compatible r f -> Functor.axioms (qdotted r f).
Proof.
ir. 
assert (Functor.axioms f). 
lu. 
uhg; ee. 
uf qdotted. 
uf Functor.create. ap Umorphism.create_like.
rw source_qdotted. 
app quotient_cat_axioms. 
rw target_qdotted. 
rww category_axioms_target. 

ir. rwi source_qdotted H2. 
rwi ob_quotient_cat H2. 
rw target_qdotted. rw fob_qdotted. app ob_fob. 
am. am. am. am. 

ir. rwi source_qdotted H2. 
rwi ob_quotient_cat H2. 
rw target_qdotted. rw fob_qdotted. 
rw source_qdotted. rw id_quotient_cat. 
rw fmor_qdotted_quot_id. 
tv. am. am. am. am. am. am. 
am. am. am. 

ir. rwi source_qdotted H2. 
rwi mor_quotient_cat H2. 
rw target_qdotted. rw fmor_qdotted. ap mor_fmor. 
am. 
apply mor_arrow_rep with (r:=r). 
am. am. am. am. 


(** the following section of the proof might provide
an example of why we need an untyped environment:
we are proving a statement about compatibility with 
target; in the usual type-theory version of category
theory this could well be part of the typing  information,
so the proof paragraph which is somewhat complicated
would be what you would have to do to show (maybe later)
that something is well-typed. **************************)

ir. rwi source_qdotted H2. 
rwi mor_quotient_cat H2. 
rw fob_qdotted. rw fmor_qdotted. 
rw source_fmor. 
rewrite source_arrow_rep with (a:=source f) (r:=r).
tv. am. am. 
apply mor_arrow_rep with (r:=r). 
am. am. am. am. am. 
uh H2; ee. nin H3; ee. rw H4. 
rw source_arrow_class. rww ob_source. 
am. 

ir. rwi source_qdotted H2. 
rwi mor_quotient_cat H2. 
rw fob_qdotted. rw fmor_qdotted. 
rw target_fmor. 
rewrite target_arrow_rep with (a:=source f) (r:=r).
tv. am. am. 
apply mor_arrow_rep with (r:=r). 
am. am. am. am. am. 
uh H2; ee. nin H3; ee. rw H4. 
rw target_arrow_class. rww ob_target. 
am. 

ir. rwi source_qdotted H2. 
rwi mor_quotient_cat H2. 
rwi source_qdotted H3. 
rwi mor_quotient_cat H3. 

rw target_qdotted. sy. 
rw source_qdotted. 
rw comp_quotient_cat. 
rw fmor_qdotted_quot_comp. tv. am. am. am. 
am. am. am. am. am. am. am. am. 
Qed.

Lemma eq_fcompose_qdotted_qprojection : forall r f,
cat_equiv_rel (source f) r  -> 
compatible r f -> f = fcompose (qdotted r f) (qprojection (source f) r).
Proof.
ir. 
apply Functor.axioms_extensionality. 
lu. 
ap fcompose_axioms. 
ap qdotted_axioms. am. am. 
ap qprojection_axioms. 
am. 
rw source_qdotted. rw target_qprojection. tv. 
rw source_fcompose. rw source_qprojection. 
tv. 
rw target_fcompose. rw target_qdotted. tv. 

ir. rw fmor_fcompose. 
assert (fmor (qprojection (source f) r) u = arrow_class r u). 

rww fmor_qprojection. 
rw H2. 
rw fmor_qdotted_arrow_class. tv. am. am. 
am. app qdotted_axioms. 
app qprojection_axioms. 
rw source_qdotted. rw target_qprojection. 
tv. rw source_qprojection. am. 
Qed.

Lemma compatible_fcompose_qprojection : forall a r f,
Functor.axioms f -> cat_equiv_rel a r ->
source f = quotient_cat a r -> 
compatible r (fcompose f (qprojection a r)).
Proof.
ir. 

rw compatible_rw; ee. 
ap fcompose_axioms. am. 
app qprojection_axioms. 
rww target_qprojection. 
rw source_fcompose. rw source_qprojection. lu. 

ir. 
assert (mor a x). 
uh H0; ee. uh H0; ee. apply H7 with y; am. 
assert (mor a y). 
uh H0; ee. uh H0; ee. apply H9 with x; am. 

rw fmor_fcompose. 
sy; rw fmor_fcompose. 
rw fmor_qprojection. 
rw fmor_qprojection. 
rewrite related_arrow_class_eq with (a:=a) in H2. 
rw H2. tv. am. am. am. am. am. 
app qprojection_axioms. 
rww target_qprojection. rww source_qprojection. 
am. app qprojection_axioms. 
rww target_qprojection. 
rww source_qprojection. 
Qed.


(** the following gives unicity for qdotted **)

Lemma eq_qdotted : forall a r f,
Functor.axioms f -> cat_equiv_rel a r ->
source f = quotient_cat a r -> 
f = qdotted r (fcompose f (qprojection a r)).
Proof.
ir. 
ap Functor.axioms_extensionality. 
am. 
ap qdotted_axioms. 
rw source_fcompose. rww source_qprojection. 
app compatible_fcompose_qprojection. 
rw source_qdotted. 
rw source_fcompose. rw source_qprojection. am. 
rw target_qdotted. rw target_fcompose. tv. 

ir. 
rw fmor_qdotted. 
rw fmor_fcompose. 
rw fmor_qprojection_arrow_rep. tv. 
rwi H1 H2. 
rwi mor_quotient_cat H2. am. am. am. 
app qprojection_axioms. 
rww target_qprojection. 
rw source_qprojection. 
apply mor_arrow_rep with (a:=a)(r:=r). 
rwi H1 H2. 
rwi mor_quotient_cat H2. am. am.
rw source_fcompose. rww source_qprojection. 

rw source_fcompose. rww source_qprojection. 
rwi H1 H2. 
rwi mor_quotient_cat H2. am. am.
Qed.




End Quotient_Functor. 


Module Ob_Iso_Functor.
Export Functor_Cat.
Export Quotient_Functor. 

(** We study the situation of a functor f 
which is an isomorphism on objects;
in particular we look at the 
morphism it induces on functor categories.
This will allow us, for now, to skip
talking about natural transformations to and from
quotient categories. Eventually of course it would
be desireable to have that theory too. **)

Definition pull_morphism a f :=
Functor.create (functor_cat (target f) a) (functor_cat (source f) a) (fun u => htrans_right u f).

Lemma source_pull_morphism : forall f a,
source (pull_morphism a f) = (functor_cat (target f) a).
Proof.
ir. uf pull_morphism. 
rw Functor.source_create. tv. 
Qed.

Lemma target_pull_morphism : forall f a,
target (pull_morphism a f) = (functor_cat (source f) a).
Proof.
ir. uf pull_morphism. 
rw Functor.target_create. tv. 
Qed.

Lemma fmor_pull_morphism : forall f a u,

mor (functor_cat (target f) a) u -> 
fmor (pull_morphism a f) u = htrans_right u f.
Proof.
ir. 
uf pull_morphism. 
rw fmor_create. tv. 
am. 
Qed.

Lemma fob_pull_morphism : forall f a y,
Functor.axioms f -> Category.axioms a -> 
ob (functor_cat (target f) a) y -> 
fob (pull_morphism a f) y = fcompose y f.
Proof.
ir. 
assert (Category.axioms (target f)). 
uh H; ee; am. 
uf fob. 
rw fmor_pull_morphism. 
rw source_htrans_right. 
rw source_pull_morphism. 
rw id_functor_cat. 
rw source_vident. tv. 
am. am. 
am. 
rw source_pull_morphism. app mor_id. 
Qed.

Lemma pull_morphism_axioms : forall f a,
Functor.axioms f -> Category.axioms a -> 
Functor.axioms (pull_morphism a f).
Proof.
ir. 
assert (Category.axioms (source f)). 
uh H; ee; am. 
assert (Category.axioms (target f)).
uh H; ee; am. 

uhg; ee. 
uf pull_morphism; uf Functor.create; ap Umorphism.create_like.

rw source_pull_morphism. 
app functor_cat_axioms. 
rw target_pull_morphism.
app functor_cat_axioms. 

ir. rwi source_pull_morphism H3. 
cp H3. rwi ob_functor_cat H4. uh H4; ee. 

rw target_pull_morphism. 
rw fob_pull_morphism. 
rww ob_functor_cat. uhg; ee. 
app fcompose_axioms. rww source_fcompose. 
rww target_fcompose. am. am. 
am. am. am. 

ir. 
rwi source_pull_morphism H3. cp H3. 
rwi ob_functor_cat H4. uh H4; ee. 
rw target_pull_morphism. 
rw fob_pull_morphism. 
rw source_pull_morphism. 
rw fmor_pull_morphism. 
rw id_functor_cat. 
rw id_functor_cat. sy. 
rw htrans_right_vident. reflexivity. am. am. 
am. am. am. am. am. am. 
rw ob_functor_cat. uhg; ee. 
app fcompose_axioms. rww source_fcompose. 
rww target_fcompose. am. am. 
rw id_functor_cat. rw mor_functor_cat.
uhg; ee. 
rww vident_axioms. 
rww osource_vident. 
rww otarget_vident. am. am. am. am. 
am. am. am. am. am. am. 

ir. rwi source_pull_morphism H3. cp H3.
rwi mor_functor_cat H4. uh H4; ee. 
rw target_pull_morphism. 
rw fmor_pull_morphism. 
rw mor_functor_cat. uhg; ee. 
app htrans_right_axioms. 
rww osource_htrans_right. rww otarget_htrans_right.
am. am. am. am. am. 

ir. rwi source_pull_morphism H3. cp H3.
rwi mor_functor_cat H4. uh H4; ee. 
rw fmor_pull_morphism. rw fob_pull_morphism. 
rw source_htrans_right. tv. am. am. 
rww ob_source. am. am. am. 

ir. rwi source_pull_morphism H3. cp H3.
rwi mor_functor_cat H4. uh H4; ee. 
rw fmor_pull_morphism. rw fob_pull_morphism. 
rw target_htrans_right. tv. am. am. 
rww ob_target. am. am. am. 

ir. rwi source_pull_morphism H3. 
rwi source_pull_morphism H4. 
cp H3; cp H4. 
rwi mor_functor_cat H6. uh H6; ee. 
rwi mor_functor_cat H7. uh H7; ee. 

rw target_pull_morphism. 
sy; rw source_pull_morphism. 
rw comp_functor_cat. rw comp_functor_cat. 
rw fmor_pull_morphism. sy. 
rw fmor_pull_morphism. rw fmor_pull_morphism.
rw vcompose_htrans_right_htrans_right. 
tv. am. am. am. tv. am. sy; am. 
am. am. 
rw mor_functor_cat. 
uhg; ee. rww vcompose_axioms. 
rww osource_vcompose. rww otarget_vcompose. 
am. am. am. am. 
rw mor_functor_cat. 
rw fmor_pull_morphism. uhg; ee. 
app htrans_right_axioms. 
rww osource_htrans_right. rww otarget_htrans_right. 
am. am. am. 

rw mor_functor_cat. rw fmor_pull_morphism. 
uhg; ee.  app htrans_right_axioms. 
rww osource_htrans_right. rww otarget_htrans_right. 
am. am. am. 

rw fmor_pull_morphism. rw fmor_pull_morphism. 
rww source_htrans_right. rw target_htrans_right. 
rww H5. am. am. am. am. am. am. 
am. am. am. am. am. 
Qed.


Definition faithful f :=
Functor.axioms f &
(forall u v, related (ker f) u v -> u = v).

Definition says f x :=
Functor.axioms f &
(exists y, (ob (source f) y & fob f y = x)).

Definition msays f u :=
Functor.axioms f &
(exists y, (mor (source f) y & fmor f y = u)).


Definition full f :=
Functor.axioms f &
(forall u, mor (target f) u -> 
says f (source u) -> says f (target u) -> msays f u).

Definition ob_inj f :=
Functor.axioms f &
(forall x y, ob (source f) x -> ob (source f) y -> fob f x = fob f y -> x = y).

Definition iso_to_full_subcategory f :=
faithful f & full f & ob_inj f.

Definition ob_image f :=
Z (objects (target f)) 
(fun x => (exists y, (ob (source f) y & fob f y = x))).



Definition ob_surj f :=
Functor.axioms f &
(forall x, ob (target f) x -> says f x).

Definition ob_iso f :=
ob_inj f & ob_surj f.

Lemma has_finverse_rw : forall f,
has_finverse f = (faithful f & full f & ob_iso f).
Proof.
ir. 
ap iff_eq; ir. uh H. nin H.
uh H; ee. 
uhg; ee. 
am. ir. 
rwi related_ker H5. ee. 
transitivity (fmor x (fmor f u)).
wr fmor_fcompose. rw H4. rw fmor_fidentity. 
tv. am. am. am. am. am. rw H9.
wrr fmor_fcompose. rw H4. rww fmor_fidentity. am. 
uhg; ee. 
am. ir. uhg; ee.
am. sh (fmor x u).
ee. 
rw H1. app mor_fmor. rww H2. wrr fmor_fcompose. 
rw H3. rww fmor_fidentity. rww H2. rww H2. 

uhg. ee. uhg; ee. 
am. ir. transitivity (fob x (fob f x0)).
wrr fob_fcompose. rw H4. rww fob_fidentity. 
rw H7. wrr fob_fcompose. rw H4. rww fob_fidentity. 
uhg; ee; try am. ir. uhg; ee. 
am. sh (fob x x0).
ee. rw H1. app ob_fob. rww H2. 
wrr fob_fcompose. rw H3. rww fob_fidentity. rww H2. rww H2.

ee.
uh H; uh H0; uh H1; ee. 
uh H1; uh H2; ee. 
clear H0 H1 H2. 
set (gmprop := fun x => fun y => (mor (source f) y & fmor f y = x)).
set (gm := fun x => choose (gmprop x)).

assert (lem1 : forall x, mor (target f) x -> ex (gmprop x)).
ir. assert (msays f x).
ap H3. am. ap H5. rww  ob_source. 
ap H5. rww ob_target. uh H1; ee. am. 

assert (lem2 : forall x, mor (target f) x -> 
(mor (source f) (gm x) & fmor f (gm x) = x)).
ir. 
change (gmprop x (gm x)).
uf gm. ap choose_pr. app lem1. 

set (gobprop := fun x => fun y => (ob (source f) y & fob f y = x)).
set (gob := fun x => choose (gobprop x)).

assert (lem3 : forall x, ob (target f) x -> ex (gobprop x)).
ir. assert (says f x).
ap H5. am.  uh H1; ee. am. 

assert (lem4 : forall x, ob (target f) x -> 
(ob (source f) (gob x) & fob f (gob x) = x)).
ir. 
change (gobprop x (gob x)).
uf gob. ap choose_pr. app lem3. 

assert (source_gm : forall u, mor (target f) u ->
source (gm u) = gob (source u)).
ir. cp (lem2 _ H0); ee.
assert (ob (target f) (source u)).
rww ob_source. cp (lem4 _ H7). ee.
ap H6. 
rww ob_source. am. 
rw H9. wr source_fmor. rw H2. tv. 
am. am. 


assert (target_gm : forall u, mor (target f) u ->
target (gm u) = gob (target u)).
ir. cp (lem2 _ H0); ee.
assert (ob (target f) (target u)).
rww ob_target. cp (lem4 _ H7). ee.
ap H6. 
rww ob_target. am. 
rw H9. wr target_fmor. rw H2. tv. 
am. am. 

assert (id_gob : forall x, ob (target f) x ->
id (source f) (gob x) = gm (id (target f) x)).
ir. ap H4. 
cp (lem4 _ H0); ee. 

rw related_ker. ee. 
app mor_id. 
assert (mor (target f) (id (target f) x)).
app mor_id. cp (lem2 _ H7). 
ee; am. rw source_gm. 
rww source_id. rww source_id. 
app mor_id. 
rww target_id. rww target_gm. rww target_id. 
app mor_id. 
rw fmor_id. rw H2. 
assert (mor (target f) (id (target f) x)). 
app mor_id. cp (lem2 _ H7). 
ee. sy; am. am. tv. am. am. 

assert (comp_gm : forall u v, mor (target f) u ->
mor (target f) v -> source u = target v ->
comp (source f) (gm u) (gm v) = gm (comp (target f) u v)).
ir. 
cp (lem2 _ H0); cp (lem2 _ H1); ee.
assert (mor (target f) (comp (target f) u v)). 
rww mor_comp. cp (lem2 _ H11). ee. 


ap H4. 
rw related_ker. 
ee.
rww mor_comp. rww source_gm; rww target_gm. rww H2. 
am. rww source_comp. rww source_gm. rww source_gm. 
rww source_comp. rww source_gm. rww target_gm. 
rww H2. 
rww target_comp. rww target_gm. rww target_gm.
rww target_comp. rww source_gm. rww target_gm. 
rww H2. 
wrr comp_fmor. rw H13. 
rw H10; rw H9. tv. rw source_gm. rw target_gm. 
rww H2. am. am. am. 




uhg. 
sh (Functor.create (target f) (source f) gm).
uhg; dj.
am. 
ap Functor.create_axioms. 
sh gob. uhg; ee.
rww category_axioms_target. 
rww category_axioms_source. 
ir. 
cp (lem4 _ H1); ee; am. 
ir.
app id_gob. 
ir. 
cp (lem2 _ H1); ee; am. 
ir. 
rww source_gm. 
ir. 
rww target_gm. 
ir. 
rww comp_gm. 
rww Functor.target_create. 
rww Functor.source_create. 


(** composition in one direction **)
ap Functor.axioms_extensionality. 
ap fcompose_axioms. 
am. am. am. 
rw fidentity_axioms. tv. rw Functor.source_create.
rww category_axioms_target. 
rw source_fcompose. rw Functor.source_create. 
rw source_fidentity. tv. 
rw target_fcompose. rw target_fidentity. 
rww Functor.source_create. 

ir. 
rwi Functor.source_create H7. 
rwi source_fcompose H8. 
rwi Functor.source_create H8. 
cp (lem2 _ H8); ee.

rw fmor_fcompose. rw fmor_create.
rw fmor_fidentity. am. 
rw Functor.source_create. am. am. am. am. 
rww Functor.target_create. 
rww Functor.source_create. 


(** composition in the other direction **)


ap Functor.axioms_extensionality. 
ap fcompose_axioms. 
am. am. am. 
rw fidentity_axioms. tv. 
rww category_axioms_source. 
rw source_fcompose. 
rw source_fidentity. tv. 
rw target_fcompose. rw target_fidentity. 
rww Functor.target_create. 

ir. 
rwi Functor.source_create H7. 
rwi source_fcompose H9. 
rwi Functor.source_create H8. 


rw fmor_fcompose. rw fmor_create.
rw fmor_fidentity. 
ap H4. 
assert (mor (target f) (fmor f u)).
app mor_fmor. 
cp (lem2 _ H10); ee.

rw related_ker. 
ee.
am. am. rww source_gm. rww source_fmor. 
assert (ob (target f) (fob f (source u))).
app ob_fob. rww ob_source. 
cp (lem4 _ H13); ee. app H6. 
rww ob_source. 
rww target_gm. 
rww target_fmor. 
assert (ob (target f) (fob f (target u))).
app ob_fob. rww ob_target. 
cp (lem4 _ H13); ee. app H6. 
rww ob_target. am. am. am. 
app mor_fmor. 
am. am. 
rww Functor.source_create. am. 
Qed. 


Definition is_full_subcategory a b :=
is_subcategory a b &
(forall u, mor b u -> ob a (source u) -> ob a (target u) ->
mor a u).

Definition full_subcategory (a:E) (obp : E -> Prop) :=
subcategory a obp (fun u => (obp (source u) & obp (target u))).

Lemma full_subcategory_property : forall a obp,
Category.axioms a -> subcategory_property a obp 
(fun u => (obp (source u) & obp (target u))).
Proof.
ir. 
uhg; ee.
am. ir. ee.
rww source_comp. rww target_comp.
ir.
ee. rww source_id. rww target_id.
ir. 
ee; am. 
ir. 
ee; am. 
Qed.

Lemma full_subcategory_axioms : forall a obp,
Category.axioms a -> 
Category.axioms (full_subcategory a obp).
Proof.
ir. 
uf full_subcategory. 
ap subcategory_axioms. 
ap full_subcategory_property.
am. 
Qed.



Lemma is_subcategory_full_subcategory : forall a obp,
Category.axioms a ->
is_subcategory (full_subcategory a obp) a.
Proof.
ir.
uf full_subcategory.
ap subcategory_is_subcategory.
ap full_subcategory_property. am. 
Qed.

Lemma ob_full_subcategory : forall a obp x,
axioms a ->
ob (full_subcategory a obp) x = (ob a x & obp x).
Proof.
ir.
uf full_subcategory.
rw ob_subcategory. tv. 
app full_subcategory_property. 
Qed.

Lemma mor_full_subcategory : forall a obp u,
axioms a ->
mor (full_subcategory a obp) u = (mor a u & obp (source u) 
& obp (target u)).
Proof.
ir.
uf full_subcategory.
rw mor_subcategory. tv. 
app full_subcategory_property. 
Qed.

Lemma id_full_subcategory : forall a obp x,
axioms a ->
ob (full_subcategory a obp) x ->
id (full_subcategory a obp) x = id a x.
Proof.
ir.
uf full_subcategory.
rww id_subcategory. 
app full_subcategory_property. 
rwi ob_full_subcategory H0; ee; am. 
rwi ob_full_subcategory H0; ee; am. 
Qed.

Lemma comp_full_subcategory : forall a obp u v,
axioms a ->
mor (full_subcategory a obp) u ->
mor (full_subcategory a obp) v ->
source u = target v ->
comp (full_subcategory a obp) u v = comp a u v.
Proof.
ir.
uf full_subcategory.
rwi mor_full_subcategory H0. 
rwi mor_full_subcategory H1. ee. 
rww comp_subcategory. 
app full_subcategory_property. ee; am. ee; am. am. 
am. 
Qed.


Lemma is_full_subcategory_full_subcategory : forall a obp,
Category.axioms a ->
is_full_subcategory (full_subcategory a obp) a.
Proof.
ir. 
uhg; ee. 
app is_subcategory_full_subcategory. 
ir.
rwi ob_full_subcategory H1. 
rwi ob_full_subcategory H2; ee.
rww mor_full_subcategory; ee; am. am. am. 
Qed.

Definition subcategory_inclusion a b :=
Functor.create a b (fun u => u).

Lemma source_subcategory_inclusion : forall a b,
source (subcategory_inclusion a b) = a.
Proof.
ir.
uf subcategory_inclusion.
rww Functor.source_create. 
Qed.

Lemma target_subcategory_inclusion : forall a b,
target (subcategory_inclusion a b) = b.
Proof.
ir.
uf subcategory_inclusion.
rww Functor.target_create. 
Qed.

Lemma fmor_subcategory_inclusion : forall a b u,
is_subcategory a b -> mor a u ->
fmor (subcategory_inclusion a b) u = u.
Proof.
ir.
uf subcategory_inclusion.
rww fmor_create. 
Qed.

Lemma fob_subcategory_inclusion : forall a b x,
is_subcategory a b -> ob a x ->
fob (subcategory_inclusion a b) x = x.
Proof.
ir.
uf subcategory_inclusion.
rw fob_create. rww source_id. am. 
Qed.




Lemma subcategory_inclusion_axioms : forall a b,
is_subcategory a b -> 
Functor.axioms (subcategory_inclusion a b).
Proof.
ir.
uf subcategory_inclusion.
uh H; ee. 

ap Functor.create_axioms. 
sh (fun x:E => x).
uhg; ee.
am. am. 
am. ir; sy; au. am. 
ir; tv. ir; tv. 
ir. 
rww H4. 
Qed.

Lemma faithful_subcategory_inclusion : forall a b,
is_subcategory a b ->
faithful (subcategory_inclusion a b).
Proof.
ir.
uhg; ee. 
app subcategory_inclusion_axioms. 
uh H; ee.
ir. 
rwi related_ker H6; ee. 
rwi source_subcategory_inclusion H6.
rwi source_subcategory_inclusion H7. 
rwi fmor_subcategory_inclusion H10. 
rwi fmor_subcategory_inclusion H10. am.
uhg; ee; am. am. uhg; ee; am. am. 
ap subcategory_inclusion_axioms. uhg; ee; am. 
Qed.

Lemma ob_inj_subcategory_inclusion : forall a b,
is_subcategory a b ->
ob_inj (subcategory_inclusion a b).
Proof.
ir.
uhg.
ee.
app subcategory_inclusion_axioms.
ir.
rwi source_subcategory_inclusion H0;
rwi source_subcategory_inclusion H1; ee.
rwi fob_subcategory_inclusion H2.
rwi fob_subcategory_inclusion H2.
am. am. am. am.
am. 
Qed.

Lemma full_subcategory_inclusion : forall a b,
is_full_subcategory a b ->
full (subcategory_inclusion a b).
Proof.
ir.
uh H; ee.
uhg; ee.
app subcategory_inclusion_axioms. 

ir.
rwi target_subcategory_inclusion H1.
uhg; ee.
app subcategory_inclusion_axioms. 
sh u. 
ee.
rw source_subcategory_inclusion.
app H0. 
uh H2; ee. 
nin H4.
ee.
rwi source_subcategory_inclusion H4.
rwi fob_subcategory_inclusion H5. wrr H5. 
am. am. 
uh H3; ee. 
nin H4.
ee.
rwi source_subcategory_inclusion H4.
rwi fob_subcategory_inclusion H5. wrr H5. 
am. am. 

rww fmor_subcategory_inclusion. 

app H0. 
uh H2; ee. 
nin H4.
ee.
rwi source_subcategory_inclusion H4.
rwi fob_subcategory_inclusion H5. wrr H5. 
am. am. 
uh H3; ee. 
nin H4.
ee.
rwi source_subcategory_inclusion H4.
rwi fob_subcategory_inclusion H5. wrr H5. 
am. am. 
Qed.

Lemma is_full_subcategory_rw : forall a b, 
is_full_subcategory a b = 
(is_subcategory a b & full (subcategory_inclusion a b)).
Proof.
ir.
ap iff_eq; ir.
ee.
uh H; ee; am. 
app full_subcategory_inclusion.
ee.
uhg; ee; try am. 
ir.
uh H0; ee.
assert (msays (subcategory_inclusion a b) u).
ap H4.
rww target_subcategory_inclusion.
uhg; ee.
app subcategory_inclusion_axioms. 
sh (source u). ee.
rww source_subcategory_inclusion.
rww fob_subcategory_inclusion.
uhg; ee.
app subcategory_inclusion_axioms. 
sh (target u). ee.
rww source_subcategory_inclusion.
rww fob_subcategory_inclusion.

uh H5; ee.
nin H6; ee.
rwi source_subcategory_inclusion H6.
rwi fmor_subcategory_inclusion H7. wrr H7.
am. am. 
Qed.

Definition ob_image_fs f :=
full_subcategory (target f) (fun x => inc x (ob_image f)).

Lemma is_subcategory_ob_image_fs : forall f,
Functor.axioms f ->
is_subcategory (ob_image_fs f) (target f).
Proof.
ir.
uf ob_image_fs.
app is_subcategory_full_subcategory. 
rww category_axioms_target.
Qed.


Lemma is_full_subcategory_ob_image_fs : forall f,
Functor.axioms f ->
is_full_subcategory (ob_image_fs f) (target f).
Proof.
ir.
uf ob_image_fs.
app is_full_subcategory_full_subcategory. 
rww category_axioms_target.
Qed.

Lemma inc_ob_image : forall f x,
Functor.axioms f ->
inc x (ob_image f) = (exists y, (ob (source f) y & fob f y = x)).
Proof.
ir.
ap iff_eq; ir.
ufi ob_image H0. 
Ztac.
uf ob_image. 
Ztac. 
ap ob_is_ob.
nin H0.
ee. 
wr H1. app ob_fob.
Qed.


Lemma ob_ob_image_fs : forall f x,
Functor.axioms f ->
ob (ob_image_fs f) x = inc x (ob_image f).
Proof.
ir.
ap iff_eq; ir.
ufi ob_image_fs H0.
rwi ob_full_subcategory H0.
ee.
am. 
rwi ob_full_subcategory H0. 
rww category_axioms_target.
rww category_axioms_target.
uf ob_image_fs.
rw ob_full_subcategory.
ee.
rwi inc_ob_image H0.
nin H0; ee.
wr H1. app ob_fob. am. 
am. rww category_axioms_target. 
Qed.

Lemma mor_ob_image_fs : forall f u,
Functor.axioms f ->
mor (ob_image_fs f) u =
(mor (target f) u & inc (source u) (ob_image f) & 
inc (target u) (ob_image f)).
Proof.
ir.
ap iff_eq; ir.
ufi ob_image_fs H0.
rwi mor_full_subcategory H0.
xd.
rww category_axioms_target.

uf ob_image_fs.
rw mor_full_subcategory; xd.
rww category_axioms_target.
Qed.


Definition ob_image_factor f :=
Functor.create (source f) (ob_image_fs f)
(fmor f).

Lemma source_ob_image_factor : forall f,
source (ob_image_factor f) = source f.
Proof.
ir.
uf ob_image_factor.
rww Functor.source_create.
Qed.

Lemma target_ob_image_factor : forall f,
target (ob_image_factor f) = ob_image_fs f.
Proof.
ir.
uf ob_image_factor.
rww Functor.target_create.
Qed.

Lemma fmor_ob_image_factor : forall f u,
Functor.axioms f -> mor (source f) u -> 
fmor (ob_image_factor f) u = fmor f u.
Proof.
ir.
uf ob_image_factor.
rww fmor_create.
Qed.

Lemma fob_ob_image_factor : forall f x,
Functor.axioms f -> ob (source f) x -> 
fob (ob_image_factor f) x = fob f x.
Proof.
ir.
uf ob_image_factor.
rww fob_create.
Qed.


Lemma ob_image_factor_axioms : forall f,
Functor.axioms f ->
Functor.axioms (ob_image_factor f).
Proof.
ir.
uf ob_image_factor.

assert (is_full_subcategory (ob_image_fs f) (target f)).
app is_full_subcategory_ob_image_fs.
uh H0; ee.
uh H0; ee. 


ap Functor.create_axioms.
sh (fob f).
uhg; ee.
rww category_axioms_source. 
am. 
ir.
uf ob_image_fs. 
rw ob_full_subcategory.
ee. 
app ob_fob. 
uf ob_image.
Ztac. 
ap ob_is_ob. app ob_fob. 
sh x; ee.
am. tv. 
rww category_axioms_target.


ir.
rw H7. 
rww fmor_id. 
rw ob_ob_image_fs. 
rw inc_ob_image. 
sh x; ee. am. tv. am. 
am. 

ir. 
rw mor_ob_image_fs.
ee.
app mor_fmor. rw inc_ob_image.
sh (source u).
ee.
rww ob_source. rww source_fmor. am. 
rw inc_ob_image. 
sh (target u).
ee.
rww ob_target. rww target_fmor.
am. am. 

ir.
rww source_fmor.

ir. rww target_fmor.

ir.
uf ob_image_fs.
rww comp_full_subcategory.
rww comp_fmor.
rw mor_full_subcategory.
ee.
app mor_fmor.
rw inc_ob_image.
sh (source u).
ee.
rww ob_source. rww source_fmor. am. 
rw inc_ob_image. 
sh (target u).
ee.
rww ob_target. rww target_fmor.
am. am. 

rw mor_full_subcategory.
ee.
app mor_fmor.
rw inc_ob_image.
sh (source v).
ee.
rww ob_source. rww source_fmor. am. 
rw inc_ob_image. 
sh (target v).
ee.
rww ob_target. rww target_fmor.
am. am. 

rww source_fmor. 
rww target_fmor.
rww H10.
Qed.


Lemma ob_image_factorization : forall f,
Functor.axioms f -> 
f = fcompose 
(subcategory_inclusion (ob_image_fs f) (target f)) 
(ob_image_factor f). 
Proof.
ir.
cp (ob_image_factor_axioms H).
cp (is_full_subcategory_ob_image_fs H).
cp H1.
uh H2.
ee.
cp H2.
uh H4; ee.


ap Functor.axioms_extensionality.
am. 
ap fcompose_axioms. 
app subcategory_inclusion_axioms.
app ob_image_factor_axioms.

rww source_subcategory_inclusion.
rww target_ob_image_factor.
rww source_fcompose.
rww source_ob_image_factor.
rww target_fcompose.
rww target_subcategory_inclusion.


ir.
rw fmor_fcompose.
rw fmor_subcategory_inclusion.
rw fmor_ob_image_factor.
tv. 
am. am. 
am. 
assert (ob_image_fs f = target (ob_image_factor f)).
rww target_ob_image_factor.
rw H12. 
ap mor_fmor. am. 
rww source_ob_image_factor. 
app subcategory_inclusion_axioms.
am. 
rww source_subcategory_inclusion.
rww target_ob_image_factor.
rww source_ob_image_factor. 
Qed.

Lemma ob_surj_ob_image_factor : forall f,
Functor.axioms f -> 
ob_surj (ob_image_factor f).
Proof.
ir.
uhg; ee.
app ob_image_factor_axioms. 
ir. 
rwi target_ob_image_factor H0.
rwi ob_ob_image_fs H0.
rwi inc_ob_image H0; nin H0; ee.

uhg; ee.
app ob_image_factor_axioms.
sh x0.
ee.
rww source_ob_image_factor.
rww fob_ob_image_factor.
am. am. 
Qed.

Lemma ob_inj_ob_image_factor : forall f,
Functor.axioms f -> 
ob_inj (ob_image_factor f) = ob_inj f.
Proof.
ir.
ap iff_eq; ir.
uh H0; ee.
uhg; ee; try am. 
ir.
ap H1.
rww source_ob_image_factor.
rww source_ob_image_factor. 
rww fob_ob_image_factor.
rww fob_ob_image_factor.

uh H0; ee.
uhg; ee.
app ob_image_factor_axioms.

ir.
ap H1.
wrr source_ob_image_factor. 
wrr source_ob_image_factor. 
wrr fob_ob_image_factor.
sy.
wrr fob_ob_image_factor.
sy; am. 
wrr source_ob_image_factor. 
wrr source_ob_image_factor. 
Qed.

Lemma ob_iso_ob_image_factor : forall f,
Functor.axioms f -> 
ob_iso (ob_image_factor f) = ob_inj f.
Proof.
ir.
ap iff_eq; ir.
uh H0; ee.
rwi ob_inj_ob_image_factor H0.
am. am. 
uhg; ee.
rww ob_inj_ob_image_factor.
app  ob_surj_ob_image_factor.
Qed.

Lemma full_ob_image_factor : forall f,
Functor.axioms f -> 
full (ob_image_factor f) = full f.
Proof.
ir. 
ap iff_eq; ir.
uh H0; ee.
uhg; ee.
am. 
ir.
assert (inc (source u) (ob_image f)).
uh H3; ee.
rw inc_ob_image.
am. am. 
assert (inc (target u) (ob_image f)).
uh H4; ee.
rw inc_ob_image.
am. am. 

assert (msays (ob_image_factor f) u).
ap H1.
rww target_ob_image_factor.
rw  mor_ob_image_fs.
ee.
am. am. am. am. 
uhg; ee.
am. uh H3; ee.
nin H7. 
sh x; ee.
rww source_ob_image_factor.
rww fob_ob_image_factor. 
uhg; ee.
am. uh H4; ee.
nin H7. 
sh x; ee.
rww source_ob_image_factor.
rww fob_ob_image_factor. 

uh H7; ee.
nin H8; ee.
uhg; ee.
am. sh x.
ee.
wrr source_ob_image_factor.
wrr fmor_ob_image_factor. 
wrr source_ob_image_factor.


uh H0; ee.
uhg; ee.
app ob_image_factor_axioms.

ir.
uhg; ee.
app ob_image_factor_axioms.

rwi target_ob_image_factor H2.
rwi mor_ob_image_fs H2.
ee.
rwi inc_ob_image H5.
rwi inc_ob_image H6.
nin H5; nin H6; ee.
assert (msays f u).
app H1.
uhg; ee.
am. sh x; ee; am. 
uhg; ee.
am. sh x0; ee; am. 

uh H9; ee.
nin H10; ee.
sh x1.
ee.
rww source_ob_image_factor.
rww fmor_ob_image_factor.
am. am. am. 
Qed.

Lemma faithful_ob_image_factor : forall f,
Functor.axioms f -> 
faithful (ob_image_factor f) = faithful f.
Proof.
ir.
ap iff_eq; ir.
uh H0; uhg; ee.
am. ir.
rwi related_ker H2.
ee.
ap H1.
rw related_ker.
ee.
rww source_ob_image_factor.
rww source_ob_image_factor.
am. am. 
rww fmor_ob_image_factor.
rww fmor_ob_image_factor.
app ob_image_factor_axioms.
am. 

uh H0; uhg; ee.
app  ob_image_factor_axioms.
ir.
rwi related_ker H2.
ee.
ap H1.
rw related_ker.
ee.
rwi source_ob_image_factor H2. am. 
rwi source_ob_image_factor H3. am. 
am. am. 
rwi fmor_ob_image_factor H6. 
rwi fmor_ob_image_factor H6. am. am. 
rwi source_ob_image_factor H3. am. am. 
rwi source_ob_image_factor H2. am. am. 
app ob_image_factor_axioms. 
Qed.




Lemma iso_to_full_subcategory_rw : forall f,
iso_to_full_subcategory f = 
(Functor.axioms f & has_finverse (ob_image_factor f)).
Proof.
ir.
ap iff_eq; ir.
dj.
uh H; ee. uh H; ee; am. 

rw has_finverse_rw.
uh H; ee.
rww faithful_ob_image_factor. 
rww full_ob_image_factor.
rww ob_iso_ob_image_factor.
ee.
rwi has_finverse_rw H0.
ee.
rwi faithful_ob_image_factor H0.
rwi full_ob_image_factor H1.
rwi ob_iso_ob_image_factor H2.
uhg; ee; try am. am. am. am. 
Qed.

Lemma subcategory_extensionality : forall a b c,
is_subcategory a c -> is_subcategory b c ->
(forall u, mor a u -> mor b u) -> 
(forall u, mor b u -> mor a u) -> 
a = b.
Proof.
ir.
assert (forall x, ob a x -> ob b x).
ir.
assert (x = source (id a x)).
rww source_id.
assert (mor b (id a x)).
app H1. app mor_id. rw H4.
rww ob_source. 

assert (forall x, ob b x -> ob a x).
ir.
assert (x = source (id b x)).
rww source_id.
assert (mor a (id b x)).
app H2. app mor_id. rw H5.
rww ob_source. 

assert (mor a = mor b).
ap arrow_extensionality.
ir.
ap iff_eq; ir; au.
assert (ob a = ob b).
ap arrow_extensionality.
ir.
ap iff_eq; ir; au.
cp (is_subcategory_eq H).
cp (is_subcategory_eq H0).
wr H7; wr H8.
rw H5; rww H6. 
Qed.

Lemma full_subcategory_extensionality : forall a b c,
is_full_subcategory a c -> is_full_subcategory b c ->
(forall x, ob a x -> ob b x) -> 
(forall x, ob b x -> ob a x) -> a = b.
Proof.
ir.
apply subcategory_extensionality with c.
uh H; ee; am. 
uh H0; ee; am. 
ir. 
uh H; uh H0; ee.
ap H4.
uh H; ee.
app H9.
ap H1. rww ob_source.
ap H1. rww ob_target.
ir. 
uh H; uh H0; ee.
ap H5.
uh H0; ee.
app H9.
ap H2. rww ob_source.
ap H2. rww ob_target.
Qed.

Lemma iso_to_full_subcategory_interp :forall f,
iso_to_full_subcategory f =
(exists g, (is_full_subcategory (target g) (target f) &
has_finverse g & 
f = fcompose (subcategory_inclusion (target g) (target f)) g)).
Proof.
ir.
ap iff_eq; ir.
sh (ob_image_factor f).
ee.
rw target_ob_image_factor.
ap is_full_subcategory_ob_image_fs.
uh H; ee. uh H; ee; am. 
rwi iso_to_full_subcategory_rw H.
ee; am. 
rw target_ob_image_factor.
ap ob_image_factorization.
uh H; ee; uh H; ee; am. 


nin H; ee.
assert (Functor.axioms x).
uh H0; ee.
nin H0.
uh H0; ee.
am. 

assert (Functor.axioms f).
rw H1.
app fcompose_axioms.
app subcategory_inclusion_axioms.
uh H; ee; am. 
rww source_subcategory_inclusion.

assert (source f = source x).
rw H1. rww source_fcompose.



assert (x = ob_image_factor f).
ap Functor.axioms_extensionality.
am. 
app ob_image_factor_axioms. 
rww source_ob_image_factor.
sy; am. 
rw target_ob_image_factor.
apply full_subcategory_extensionality with (target f).
am. 
ap is_full_subcategory_ob_image_fs.
am. 
ir.
rww ob_ob_image_fs.
rw inc_ob_image.
rwi has_finverse_rw H0.
ee.
uh H7; ee.
uh H8; ee.
cp (H9 _ H5).
uh H10; ee.
nin H11.
ee.
sh x1.
ee. rww H4. 
rw H1. rww fob_fcompose.
rww fob_subcategory_inclusion.
uh H; ee; am. rww H12. 
app subcategory_inclusion_axioms. uh H; ee; am. 
rww source_subcategory_inclusion. am. 
ir. 
rwi ob_ob_image_fs H5. 
rwi inc_ob_image H5. nin H5; ee.
rwi H1 H6. rwi fob_fcompose H6. 
rwi fob_subcategory_inclusion H6. wr H6.
app ob_fob. wrr H4. 
uh H; ee; am. app ob_fob. wrr H4. 
ap subcategory_inclusion_axioms. uh H; ee; am. 
am. rww source_subcategory_inclusion. 
wrr H4. am. am. 

ir. 
rw fmor_ob_image_factor. 
rw H1. rww fmor_fcompose. 
rww fmor_subcategory_inclusion. 
uh H; ee; am. app mor_fmor. 
ap subcategory_inclusion_axioms. uh H; ee; am. 
rww source_subcategory_inclusion. am. rww H4. 

rw iso_to_full_subcategory_rw. ee. 
am. wrr H5. 
Qed. 



Definition mor_image f :=
Z (morphisms (target f)) (msays f).

Lemma sub_mor_image : forall f,
sub (mor_image f) (morphisms (target f)).
Proof.
ir. 
uhg; ir. ufi mor_image H. Ztac. 
Qed.

Lemma inc_mor_image : forall f u,
Functor.axioms f -> 
inc u (mor_image f) = (exists v, (mor (source f) v & 
fmor f v = u)).
Proof.
ir. ap iff_eq; ir. 
ufi mor_image H0. Ztac. 
uh H2. ee. nin H3. ee. sh x; ee; am. 
uf mor_image. nin H0. 
ee. 
ap Z_inc. 
ap mor_is_mor. wr H1. 
app mor_fmor. uhg. 
ee; try am. sh x; ee; am. 
Qed. 







Definition add_inverses a s :=
Z (morphisms a) 
(fun y => inc y s \/ (invertible a y & inc (inverse a y) s)).

Lemma sub_add_inverses_refl : forall a s,
sub s (morphisms a) -> sub s (add_inverses a s).
Proof.
ir. 
uhg; ir. 
uf add_inverses. ap Z_inc. app H. 
app or_introl. 
Qed.

Lemma sub_add_inverses_morphisms : forall a s,
sub (add_inverses a s) (morphisms a).
Proof.
ir. 
uhg; ir. 
ufi add_inverses H. Ztac. 
Qed.

Lemma inc_add_inverses : forall a s y,
Category.axioms a -> sub s (morphisms a) ->
inc y (add_inverses a s) = 
(mor a y & (inc y s \/ (invertible a y & inc (inverse a y) s))).
Proof.
ir. 
ap iff_eq; ir. ufi add_inverses H1; Ztac. 
ap is_mor_mor. am. am. 
ee. 
uf add_inverses. Ztac. ap mor_is_mor. am. 
Qed.

Definition inverse_closed a b := 
is_subcategory a b &
(forall u, mor a u -> invertible b u -> mor a (inverse b u)).

Lemma sub_add_inverses : forall a b s,
inverse_closed a b -> sub s (morphisms a) ->
sub (add_inverses b s) (morphisms a).
Proof.
ir. 
uhg; ir. 
rwi inc_add_inverses H1. 
ee. nin H2. ap H0. am. 
uh H; ee. 
assert (x = inverse b (inverse b x)).
rww inverse_inverse. rw H5. 
ap mor_is_mor. ap H4. 
ap is_mor_mor. uh H; ee; am. 
change (inc (inverse b x) (morphisms a)). 
ap H0. am. 
uhg; ee. sh x. ap are_inverse_symm. 
ap invertible_inverse. am. uh H; ee.
uh H; ee; am. 
uh H; ee. 
uh H; ee. uhg; ir. 
ap mor_is_mor. ap H6. ap is_mor_mor.
am. uhg. ap H0. am. 
Qed. 


Definition generates a s :=
Category.axioms a & sub s (morphisms a) & 
(forall b, is_subcategory b a -> sub s (morphisms b) -> b = a).


Lemma faithful_pull_morphism_criterion : forall f a,
Category.axioms a -> ob_surj f ->
faithful (pull_morphism a f).
Proof.
ir. 
uh H0; ee. 
uhg; ee. 
app pull_morphism_axioms. 

ir. rwi related_ker H2. ee. 
rwi source_pull_morphism H2. 
rwi source_pull_morphism H3. 
cp H2; cp H3. rwi mor_functor_cat H7.
rwi mor_functor_cat H8. uh H7; uh H8; ee. 
rwi fmor_pull_morphism H6. 
rwi fmor_pull_morphism H6. 

ap Nat_Trans.axioms_extensionality. 
am. am. am. am. 
ir. rwi H11 H13. 
cp (H1 _ H13). uh H14. 
ee. 
nin H15. ee. wr H16. 
wr ntrans_htrans_right. 
wr ntrans_htrans_right. 
rww H6. am. am. 
am. am. uh H0; ee; am. am. 
uh H0; ee; am. am. 
app pull_morphism_axioms. 
Qed. 


Definition globular t :=
(Nat_Trans.like t) &
(Category.axioms (osource t)) &
(Category.axioms (otarget t)) &
(Functor.axioms (source t)) &
(Functor.axioms (target t)) &
(source (target t)) = (osource t) &
(target (source t)) = (otarget t).


Definition natural_ob t x :=
ob (osource t) x &
mor (otarget t) (ntrans t x) &
source (ntrans t x) = fob (source t) x &
target (ntrans t x) = fob (target t) x.

Definition natural_mor t u :=
mor (osource t) u &
natural_ob t (source u) &
natural_ob t (target u) &
comp (otarget t) (ntrans t (target u)) (fmor (source t) u)
= comp (otarget t) (fmor (target t) u) (ntrans t (source u)).

Lemma nat_trans_axioms_rw : forall t,
Nat_Trans.axioms t =
(globular t &
(forall x, ob (osource t) x -> natural_ob t x) &
(forall u, mor (osource t) u -> natural_mor t u)).
Proof.
ir. 
ap iff_eq; ir. 
ee. cp H; uh H; uhg; ee. 
am. am. am. am. am. 
am. am. 

ir. uh H; uhg; ee; au. 
ir. uh H; uhg; ee; au. 
assert (ob (osource t) (source u)).
rww ob_source. 
uhg; ee; au. 
assert (ob (osource t) (target u)).
rww ob_target. 
uhg; ee; au. 

ee. uh H; ee. 
uhg; ee; try am. 

ir. cp (H0 _ H8). uh H9; ee. 
am. 

ir. cp (H0 _ H8). 
uh H9; ee; am. 
ir. cp (H0 _ H8). 
uh H9; ee; am. 

ir. cp (H1 _ H8). uh H9; ee; am. 
Qed.


Lemma natural_mor_comp :forall t u v,
globular t -> natural_mor t u -> natural_mor t v ->
source u = target v -> natural_mor t (comp (osource t) u v).
Proof.
ir. 
uh H0; uh H1; ee. 
uhg; ee. 
rw mor_comp. tv. am. am. am. 
tv. rww source_comp. 
rw target_comp. 
am. am. am. am. 
rw target_comp. 
rw source_comp. 

uh H; ee. 

assert (fmor (source t) (comp (osource t) u v) = 
comp (otarget t) (fmor (source t) u) (fmor (source t) v)).
wr source_source. 
wr comp_fmor. 
rw H14. 
reflexivity. 
am. am. am. am. 

assert (fmor (target t) (comp (osource t) u v) = 
comp (otarget t) (fmor (target t) u) (fmor (target t) v)).
wr H13. 
wr comp_fmor. reflexivity. 
am. rww H13. rww H13. am. 

rw H15. rw H16. 
wr assoc. 
rw H8. rw assoc. 

sy. rw assoc. 
wr H5. wr H2. 
reflexivity. 
uf otarget. 
ap mor_fmor. am. 
rww H13. 
uf otarget. 
ap mor_fmor. am. 
rww H13. 
uh H3. 
ee. am. 
rw source_fmor. rw target_fmor. 
rww H2. am. rww H13. am. rww H13. 
rw source_fmor. 
uh H3; ee. sy; am. 
am. rww H13. tv. 
uf otarget. ap mor_fmor. 
am. rww H13. 
uh H6; ee. am. 
wr H14. 
ap mor_fmor. am. am. 
rw source_fmor. uh H6; ee; sy; am. am.
rww H13. 
rw target_fmor. 
uh H6; ee. rw H18. rww H2. 
am. am. tv. 

uh H7; ee. am. 
wr H14. ap mor_fmor. 
am. am. 
wr H14. ap mor_fmor. am. 
am. rw target_fmor. 
uh H7; ee; am. 
am. am. 
rw source_fmor. rw target_fmor. rw H2. 
reflexivity. am. am. am. 
am. tv. 
am. am. am. am. am. am. 
Qed.


Lemma natural_mor_id : forall t x,
globular t -> natural_ob t x ->
natural_mor t (id (osource t) x).
Proof.
ir. 
uh H0; ee. 
uh H; ee. 

uhg; ee. 
ap mor_id. am. 
uhg; ee. 
rw source_id. am. am. 
rw source_id. am. am. 
rww source_id. 
rww source_id. 
rww target_id. uhg; ee; am. 

rw target_id. 
rw source_id. 
uf osource. rw fmor_id. rw H9. 
rw right_id. 
rw source_source. wr H8. rw fmor_id.
rw left_id. tv. uf otarget. 
ap ob_fob. am. 
rww H8. am. 
am. tv. am. tv. rww H8. 
wr H9. app ob_fob. am. 
am. tv. am. tv. am. am. am. 
Qed.

Lemma natural_ob_source :forall t u,
globular t -> natural_mor t u ->
natural_ob t (source u).
Proof.
ir. 
uh H0; ee; am. 
Qed.



Lemma  natural_ob_target : forall t u,
globular t -> natural_mor t u ->
natural_ob t (target u).
Proof.
ir. uh H0; ee; am. 
Qed.

Definition naturality_subcategory t :=
subcategory (osource t) (natural_ob t) (natural_mor t).

Lemma is_subcategory_naturality_subcategory : forall t,
globular t -> is_subcategory (naturality_subcategory t) (osource t).
Proof.
ir. 
uf naturality_subcategory. 
ap subcategory_is_subcategory. 
uhg; ee. 
uh H; ee; am. 
ir. app natural_mor_comp. 
ir. app natural_mor_id. 
ir. app natural_ob_source. 
ir. app natural_ob_target. 
Qed.

Lemma ob_naturality_subcategory : forall t x,
globular t -> ob (naturality_subcategory t) x = natural_ob t x.
Proof.
ir. 
uf naturality_subcategory. 
rw ob_subcategory. ap iff_eq; ir. ee; am. 
ee. uh H0; ee; am. am. 
uhg; ee. 
uh H; ee; am. 
ir. app natural_mor_comp. 
ir. app natural_mor_id. 
ir. app natural_ob_source. 
ir. app natural_ob_target. 
Qed.

Lemma mor_naturality_subcategory : forall t u,
globular t -> mor (naturality_subcategory t) u = natural_mor t u.
Proof.
ir. 
uf naturality_subcategory. 
rw mor_subcategory. ap iff_eq; ir. ee; am. 
ee. uh H0; ee; am. am. 

uhg; ee. 
uh H; ee; am. 
ir. app natural_mor_comp. 
ir. app natural_mor_id. 
ir. app natural_ob_source. 
ir. app natural_ob_target. 
Qed.

Lemma invertible_left_multiply : forall a u v w,
invertible a u -> mor a v -> mor a w ->
source u = target v -> source u = target w ->
comp a u v = comp a u w -> v = w. 
Proof.
ir. 
assert (mor a u). 
uh H; ee. nin H. uh H; ee; am. 
transitivity (comp a (comp a (inverse a u) u) v).
rw left_inverse. rw left_id. tv. 
rww ob_source. 
am. sy; am. tv. am. 
rww assoc. rw H4. 
wr assoc. rw left_inverse. 
rw left_id. tv. rww ob_source. am. sy; am. 
tv. am. app mor_inverse. am. am. 
rww source_inverse. am. tv. 
app mor_inverse. rww source_inverse. 
Qed.


Lemma natural_mor_inverse : forall t u,
globular t -> invertible (osource t) u -> 
natural_mor t u -> natural_mor t (inverse (osource t) u).
Proof.
ir. 

cp H; uh H; cp H1; uh H1; ee. 
uhg; ee. 
ap mor_inverse. am. 
rww source_inverse. 
rww target_inverse. 

rw target_inverse. 
rw source_inverse. 

rw fmor_inverse. 
rw fmor_inverse. 

apply invertible_left_multiply with (a:=otarget t)
(u:=fmor (target t) u).
uf otarget. 
ap invertible_fmor. am. 
rww H11. tv. 
rw mor_comp. tv. uh H4; ee; am. 
rw H12. ap mor_inverse. 
wr H12. ap invertible_fmor. 
am. am. tv. 
rw target_inverse. 
rw source_fmor. uh H4; ee; am. am. am. 
ap invertible_fmor. am. am. 
tv. tv. 

rw mor_comp. tv. 
ap mor_inverse. 
ap invertible_fmor. am. 
rww H11. tv. 
uh H5; ee. am. 
rw source_inverse. 
rw target_fmor. sy. uh H5; ee; am. am. 
rww H11. 
ap invertible_fmor. am. 
rww H11. tv. tv. 
rw source_fmor. rw target_comp. 
sy. uh H4; ee; am. 
uh H4; ee; am. 
rw H12. ap mor_inverse. 
ap invertible_fmor. am. am. 
am. 
rw target_inverse. rw source_fmor. 
uh H4; ee; am. am. am. 
ap invertible_fmor. am. am. 
tv. am. rww H11. 

rw source_fmor. sy. rw target_comp. 
rw target_inverse. rw source_fmor. tv. 
am. rww H11. app invertible_fmor. 
rww H11. 
app mor_inverse. app invertible_fmor. 
rww H11. uh H5; ee; am. 
rw source_inverse. rw target_fmor. 
sy. uh H5; ee; am. am. rww H11. 
app invertible_fmor. rww H11. am. rww H11. 

(** Before doing this main goal we do some
lemmas to help with the subgoals. **)

assert (lem1: mor (otarget t) (ntrans t (target u))).
uh H5; ee; am. 


assert (lem2: mor (otarget t) (fmor (target t) u)).
uf otarget. ap mor_fmor. am. rww H11. 

assert (lem3: invertible (target (target t)) (fmor (target t) u)).
ap invertible_fmor. am. rww H11. tv. 

assert (lem4: invertible (target (target t)) (fmor (source t) u)).
ap invertible_fmor. am. am. am.  

assert (lem5: mor (otarget t) (fmor (source t) u)).
uf otarget. rw target_target. wr H12. ap mor_fmor. 
am. am. 

assert (lem6: mor (otarget t) (ntrans t (source u))).
uh H4; ee; am. 

(** Here is the main part of the proof. **)

wr assoc. wr H6. 
rw assoc. rw H12. 
rw right_inverse. rw right_id. 
sy. wr assoc. 
rw right_inverse. rw left_id. tv. 

(** That was the proof, now we have 36 subgoals **)  

uf otarget. rw ob_target. tv. am. 
am. 
rw target_fmor. uh H5; ee; am. am. rww H11. tv. 
am. am. app mor_inverse. am. 
rww target_inverse. rww source_inverse. 
rw target_fmor. sy. uh H5; ee; am. am. 
rww H11. tv. rww ob_target. 
am. 
rw target_fmor. uh H5; ee; am. am. 
am. tv. 
am. am. am. 
rw H12. ap mor_inverse. am. 
rw target_fmor. uh H5; ee; am. am. am. 
rw source_fmor. sy. rw target_inverse. 
rw source_fmor. tv. am. am. 
rww H12. am. am. tv. 
am. am. 
rw H12. ap mor_inverse. am. 
rw source_fmor. sy. uh H4; ee; am. am. 
rww H11. 
rw target_inverse. rw source_fmor. 
uh H4; ee; am. am. am. 
rww H12. tv. am. rww H11. am. am. 
am. tv. am. am. 
Qed.



Lemma inverse_closed_naturality_subcategory : forall t,
globular t -> inverse_closed (naturality_subcategory t) (osource t).
Proof.
ir. 
uhg; ee. 
ap is_subcategory_naturality_subcategory. am. 
ir. 
rw mor_naturality_subcategory. 
ap natural_mor_inverse. am. am. 
wrr mor_naturality_subcategory. am. 
Qed.  

Lemma sub_add_inverses_naturality_subcategory : forall s t,
globular t -> sub s (morphisms (naturality_subcategory t)) ->
sub (add_inverses (osource t) s) (morphisms (naturality_subcategory t)).
Proof.
ir. 
ap sub_add_inverses.
app inverse_closed_naturality_subcategory. 
am. 
Qed. 


Definition equalizer_subcategory f g :=
subcategory (source f) (fun x => (fob f x = fob g x)) (fun u => (fmor f u = fmor g u)).

Lemma equalizer_subcategory_property : forall f g,
Functor.axioms f -> Functor.axioms g -> 
source f = source g -> target f = target g ->
subcategory_property (source f) 
(fun x => (fob f x = fob g x)) (fun u => (fmor f u = fmor g u)).
Proof.
ir. uhg; ee. 
uh H; ee; am. 
ir. wr comp_fmor. 
rw H1. wr comp_fmor. rw H6. rw H7. rw H2. 
reflexivity. am. wrr H1. wrr H1. am. 
am. am. am. am. 

ir. rw fmor_id. rw H1. rw fmor_id. 
rw H4. rww H2. am. tv. wrr H1. am. tv. am. 

ir. transitivity (source (fmor f u)). 
rww source_fmor. rw H4. 
rww source_fmor. wrr H1. 

ir. transitivity (target (fmor f u)). 
rww target_fmor. rw H4. 
rww target_fmor. wrr H1. 
Qed. 

Lemma is_subcategory_equalizer_subcategory : forall f g,
Functor.axioms f -> Functor.axioms g -> 
source f = source g -> target f = target g ->
is_subcategory (equalizer_subcategory f g) (source f).
Proof.
ir. uf equalizer_subcategory. 
ap subcategory_is_subcategory. 
app equalizer_subcategory_property. 
Qed.


Lemma ob_equalizer_subcategory : forall f g x,
Functor.axioms f -> Functor.axioms g -> source f = source g -> target f = target g ->
ob (equalizer_subcategory f g) x = (ob (source f) x & fob f x = fob g x).
Proof.
ir. ap iff_eq; ir. 
ufi equalizer_subcategory H3. 
rwi ob_subcategory H3. 
ee. am. am. 
app equalizer_subcategory_property. 

ee. uf equalizer_subcategory. 
rw ob_subcategory. ee; am. 
app equalizer_subcategory_property. 
Qed. 


Lemma mor_equalizer_subcategory : forall f g u,
Functor.axioms f -> Functor.axioms g -> source f = source g -> target f = target g ->
mor (equalizer_subcategory f g) u = (mor (source f) u & fmor f u = fmor g u).
Proof.
ir. ap iff_eq; ir. 
ufi equalizer_subcategory H3. 
rwi mor_subcategory H3. 
ee. am. am. 
app equalizer_subcategory_property. 

ee. uf equalizer_subcategory. 
rw mor_subcategory. ee; am. 
app equalizer_subcategory_property. 
Qed. 

Lemma mor_equ_subcat_inverse : forall f g u,
Functor.axioms f -> Functor.axioms g -> source f = source g -> target f = target g ->
invertible (source f) u -> 
mor (equalizer_subcategory f g) u ->
mor (equalizer_subcategory f g) (inverse (source f) u).
Proof.
ir. rw mor_equalizer_subcategory. 
ee. ap mor_inverse. am. 
rw fmor_inverse. rw H1.
rw fmor_inverse. 
rwi mor_equalizer_subcategory H4. ee. 
rw H5; rww H2. am. am. am. am. am. 
wrr H1. tv. am. am. tv. am. am. am. am. 
Qed. 


Lemma inverse_closed_equalizer_subcatgory : forall f g,
Functor.axioms f -> Functor.axioms g -> source f = source g -> target f = target g ->
inverse_closed (equalizer_subcategory f g) (source f).
Proof.
ir. 
uhg; ee. 
app is_subcategory_equalizer_subcategory. 

ir. 
app mor_equ_subcat_inverse. 
Qed.

Lemma mor_equ_subcat_fmor : forall f g h u,
Functor.axioms f -> Functor.axioms g -> Functor.axioms h ->
source g = target f -> source h = target f ->
fcompose g f = fcompose h f -> 
mor (source f) u -> 
mor (equalizer_subcategory g h) (fmor f u).
Proof.
ir. 
rww mor_equalizer_subcategory. 
ee. rw H2. app mor_fmor. 
transitivity (fmor (fcompose g f) u). 
rww fmor_fcompose. rw H4. rww fmor_fcompose. 
rww H3. 
transitivity (target (fcompose g f)). 
rww target_fcompose. rw H4. 
rww target_fcompose. 
Qed. 

Lemma sub_mor_image_equalizer_subcategory : forall f g h,
Functor.axioms f -> Functor.axioms g -> Functor.axioms h ->
source g = target f -> source h = target f ->
fcompose g f = fcompose h f -> 
sub (mor_image f) (morphisms (equalizer_subcategory g h)).
Proof.
ir. uhg; ir. 
rwi inc_mor_image H5. 
nin H5. ee. ap mor_is_mor. 
wr H6. 
app mor_equ_subcat_fmor. am. 
Qed.


Lemma sub_add_inverses_equalizer_subcategory : forall f g h,
Functor.axioms f -> Functor.axioms g -> Functor.axioms h ->
source g = target f -> source h = target f ->
fcompose g f = fcompose h f -> 
sub (add_inverses (target f) (mor_image f)) (morphisms (equalizer_subcategory g h)).
Proof.
ir. 
ap sub_add_inverses. 
wr H2. app inverse_closed_equalizer_subcatgory. 
rww H3. 
transitivity (target (fcompose g f)). 
rww target_fcompose. rw H4. 
rww target_fcompose. 
app sub_mor_image_equalizer_subcategory. 
Qed.
   
Lemma equalizer_subcategory_extensionality_criterion :
forall f g,
Functor.axioms f -> Functor.axioms g ->
source f = source g -> target f = target g ->
equalizer_subcategory f g = source f ->
f = g.
Proof.
ir. 
ap Functor.axioms_extensionality. 
am. am. am. am. 
ir. wri H3 H4. 
rwi mor_equalizer_subcategory H4. 
ee; am. am. am. am. am. 
Qed.

Lemma fcompose_eq_shows_eq : forall f g h,
Functor.axioms f -> Functor.axioms g -> Functor.axioms h ->
source g = target f -> source h = target f ->
fcompose g f = fcompose h f -> 
generates (target f) (add_inverses (target f) (mor_image f)) ->
g = h.
Proof.
ir. 
assert (target g = target h).
transitivity (target (fcompose g f)). 
rww target_fcompose. rw H4. 
rww target_fcompose. 
assert (equalizer_subcategory g h = target f).
uh H5; ee. ap H8. 
wr H2. app is_subcategory_equalizer_subcategory. 
rww H3. 
app sub_add_inverses_equalizer_subcategory. 
app equalizer_subcategory_extensionality_criterion. 
rww H3. rww H2. 
Qed. 


Lemma ob_inj_pull_morphism_criterion : forall f a,
Category.axioms a ->
ob_iso f -> 
generates (target f) (add_inverses (target f) (mor_image f)) ->
ob_inj (pull_morphism a f).
Proof.
ir. 
assert (Functor.axioms f). 
lu. 
uhg; ee. ap pull_morphism_axioms. am. am. 

ir. rwi source_pull_morphism H3. cp H3. 
rwi ob_functor_cat H3. 
rwi source_pull_morphism H4. cp H4. 
rwi ob_functor_cat H4. 
uh H3; uh H4; ee. 
rwi fob_pull_morphism H5; try am. 
rwi fob_pull_morphism H5; try am. 


apply fcompose_eq_shows_eq with (f:= f). 
am. am. am. am. am. am. 
am. uh H2; ee; am. am. uh H2; ee; am. am. 
Qed.

(** Now we get back to the proof of the criterion for fullness of pull_morphism,
which is what we introduced the naturality_subcategory for. This is basically
a horn-filler problem, and the ``horn'' condition is given by the
first definition we make. We then proceed to construct the filler
called (ntdotted f g h u), and use the notion of naturality_subcategory
to prove that it is a natural transformation. ******)

Definition full_pull_situation f g h u :=
Functor.axioms f &
Functor.axioms g &
Functor.axioms h &
Nat_Trans.axioms u &
source g = target f &
source h = target f &
fcompose g f = source u &
fcompose h f = target u &
ob_iso f &
generates (target f) (add_inverses (target f) (mor_image f)).

Lemma full_pull_additional_facts : forall f g h u,
full_pull_situation f g h u ->
(target g = otarget u &
target h = otarget u & 
source f = osource u &
source g = source h &
target g = target h &
osource u = source f).
Proof.
ir. 
uh H; dj; ee. wr target_source. wr H5. 
rww target_fcompose. am. 
uf otarget. wr H7. rww target_fcompose. 
uf osource. wr H7. rww source_fcompose. 
rww H7. rww H1. 
uf osource. wr H10. 
rww source_fcompose. 
Qed. 



Definition ob_inverse_pr f x y:=
ob (source f) y & fob f y = x.

Definition ob_inverse f x :=
choose (ob_inverse_pr f x).

Lemma exists_ob_inverse_pr : forall f x,
ob_iso f -> ob (target f) x ->
exists y, ob_inverse_pr f x y.
Proof.
ir. uh H; ee. uh H1; ee. 
cp (H2 _ H0). uh H3. 
ee. nin H4. ee. sh x0. 
uhg; ee. am. am. 
Qed. 

Lemma fob_ob_inverse : forall f x,
ob_iso f -> ob (target f) x ->
fob f (ob_inverse f x) = x. 
Proof.
ir. 
cp (exists_ob_inverse_pr H H0). 
cp (choose_pr H1). cbv beta in H2. 
uh H2. ee. am. 
Qed.

Lemma ob_ob_inverse : forall f x,
ob_iso f -> ob (target f) x ->
ob (source f) (ob_inverse f x).
Proof. 
ir. 
cp (exists_ob_inverse_pr H H0). 
cp (choose_pr H1). cbv beta in H2. 
uh H2. ee. am. 
Qed. 

Lemma ob_inverse_fob : forall f x,
ob_iso f -> ob (source f) x ->
ob_inverse f (fob f x) = x.
Proof.
ir. cp H. uh H; ee. uh H; ee. 
ap H3. app ob_ob_inverse. 
app ob_fob. am. 
rww fob_ob_inverse. app ob_fob. 
Qed.

Definition ntdotted f g h u :=
Nat_Trans.create g h (fun x => ntrans u (ob_inverse f x)).

Lemma source_ntdotted : forall f g h u, 
source (ntdotted f g h u) = g.
Proof.
ir. uf ntdotted. 
rw Nat_Trans.source_create. tv. 
Qed.

Lemma target_ntdotted : forall f g h u, 
target (ntdotted f g h u) = h.
Proof.
ir. uf ntdotted. 
rw Nat_Trans.target_create. tv. 
Qed.

Lemma osource_ntdotted : forall f g h u, 
osource (ntdotted f g h u) = source g.
Proof.
ir. uf osource. rww source_ntdotted. 
Qed.

Lemma otarget_ntdotted : forall f g h u, 
otarget (ntdotted f g h u) = target h.
Proof.
ir. uf otarget. rww target_ntdotted. 
Qed.

Lemma globular_ntdotted : forall f g h u,
full_pull_situation f g h u ->
globular (ntdotted f g h u).
Proof.
ir. cp (full_pull_additional_facts H). 

uh H; uhg; ee. 
uf  ntdotted. ap Nat_Trans.create_like. 
rww  osource_ntdotted. uh H6; ee; am. 
rw otarget_ntdotted. uh H7; ee; am. 
rww source_ntdotted. rww target_ntdotted. 

rw target_ntdotted. rww osource_ntdotted.
sy; am. rw source_ntdotted. rww otarget_ntdotted. 
Qed. 

Lemma ntrans_ntdotted : forall f g h u x,
full_pull_situation f g h u ->
ob (target f) x ->
ntrans (ntdotted f g h u) x =
ntrans u (ob_inverse f x).
Proof.
ir. 
uf ntdotted. 
rw ntrans_create. tv. 
ap ob_is_ob. uh H; ee.
rww H4. 
Qed.

Lemma ntrans_ntdotted_fob : forall f g h u x,
full_pull_situation f g h u ->
ob (source f) x ->
ntrans (ntdotted f g h u) (fob f x)
= ntrans u x.
Proof.
ir. 
rw ntrans_ntdotted. 
rw ob_inverse_fob. tv. 
uh H; ee; am. 
am. am. ap ob_fob. uh H; ee; am. am. 
Qed.

Lemma natural_ob_ntdotted : forall f g h u x,
full_pull_situation f g h u -> 
ob (target f) x -> 
natural_ob (ntdotted f g h u) x.
Proof.
ir. 
assert (lem1 : full_pull_situation f g h u).
am. 
cp (full_pull_additional_facts H). 
uh H; ee.
uhg; ee. 
rw osource_ntdotted. 
rww H10. 
rw otarget_ntdotted. 
rw ntrans_ntdotted. 
rw H2. 
ap mor_ntrans. am. 
rw H6. 
ap ob_ob_inverse. am. am. 
tv. am. 
am. 
rw ntrans_ntdotted. 
rw source_ntdotted. rw source_ntrans.
wr H12. 
rw fob_fcompose. 
rw fob_ob_inverse. tv. am. 
am. am. am. am. 
app ob_ob_inverse. am. 
rw H6. app  ob_ob_inverse. 
am. am. 

rw ntrans_ntdotted. 
rw target_ntdotted. 
rw target_ntrans. 
wr H13. 
rww fob_fcompose. 
rww fob_ob_inverse. app ob_ob_inverse. 
am. rw H6. app ob_ob_inverse. 
am. am. 
Qed.

Lemma natural_mor_ntdotted_fmor : forall f g h u y,
full_pull_situation f g h u ->
mor (source f) y ->
natural_mor (ntdotted f g h u) (fmor f y).
Proof.
ir. 
cp H. 
cp (full_pull_additional_facts H). 
uh H; ee. 

uhg; ee. 
rw osource_ntdotted. rw H11. 
app mor_fmor. 
ap natural_ob_ntdotted. 
am. 
rw source_fmor. app ob_fob. 
rww ob_source. am. am. 
ap natural_ob_ntdotted. 
am. 
rw target_fmor. app ob_fob. 
rww ob_target. am. am. 

rw otarget_ntdotted. 
rw target_ntdotted. rw source_ntdotted. 
rw target_fmor. rw source_fmor. 
rw ntrans_ntdotted_fob. 
rw ntrans_ntdotted_fob. 
rw H3. 
assert (fmor g (fmor f y) = fmor (source u) y).
wr H13. 
rww fmor_fcompose. 
assert (fmor h (fmor f y) = fmor (target u) y).
wr H14. 
rww fmor_fcompose. 
rw H17; rw H18. 
app carre. rww H7. am. 
rww ob_source. am. 
rww ob_target. am. am. am. am. 
Qed. 

Lemma sub_mor_image_naturality_subcategory : forall f g h u,
full_pull_situation f g h u ->
sub (mor_image f) (morphisms (naturality_subcategory (ntdotted f g h u))).
Proof.
ir. 
uhg; ir. 
ap mor_is_mor. 
rw  mor_naturality_subcategory. 
rwi inc_mor_image H0. nin H0. 
ee. wr H1. 
ap natural_mor_ntdotted_fmor. am. am. 
uh H; ee; am. 
app globular_ntdotted. 
Qed.

Lemma sub_add_inverses_naturality_subcategory_ntdotted : 
forall f g h u,
full_pull_situation f g h u ->
sub (add_inverses (target f) (mor_image f)) 
(morphisms (naturality_subcategory (ntdotted f g h u))).
Proof.
ir. 
assert (target f = osource (ntdotted f g h u)).
rww osource_ntdotted. 
uh H; ee; sy; am. rw H0. 

ap sub_add_inverses_naturality_subcategory.
app globular_ntdotted. 
ap sub_mor_image_naturality_subcategory. am. 
Qed.

Lemma naturality_subcategory_ntdotted_all : forall f g h u,
full_pull_situation f g h u ->
naturality_subcategory (ntdotted f g h u) = target f.
Proof.
ir. 
cp (sub_add_inverses_naturality_subcategory_ntdotted H).
cp H. uh H; ee. 
uh H10; ee. 
ap H12. 
assert (target f = osource (ntdotted f g h u)).
rww osource_ntdotted. sy; am. 
rw H13. 
ap is_subcategory_naturality_subcategory. 
app globular_ntdotted. 
app sub_add_inverses_naturality_subcategory_ntdotted. 
Qed.

Lemma ntdotted_axioms : forall f g h u,
full_pull_situation f g h u ->
Nat_Trans.axioms (ntdotted f g h u).
Proof.
ir. 
cp (naturality_subcategory_ntdotted_all H).
rw nat_trans_axioms_rw. 
ee.
app globular_ntdotted. 

ir. rwi osource_ntdotted H1. 
wr ob_naturality_subcategory. rw H0. 
uh H; ee. wrr H5. 
app globular_ntdotted. 

ir. rwi osource_ntdotted H1. 
wr mor_naturality_subcategory. rw H0.
uh H; ee. wrr H5. 
app globular_ntdotted. 
Qed.

Lemma htrans_right_ntdotted : forall f g h u,
full_pull_situation f g h u ->
htrans_right (ntdotted f g h u) f = u.
Proof.
ir. 
ap Nat_Trans.axioms_extensionality. 
ap htrans_right_axioms. uh H; ee; am. 
app ntdotted_axioms. 
rw osource_ntdotted. 
uh H; ee. am. 
uh H; ee; am. 
rw source_htrans_right. 
rw source_ntdotted. uh H; ee; am. 
rw target_htrans_right. rw target_ntdotted. 
uh H; ee; am. 

ir. 
rwi osource_htrans_right H0. 
rw ntrans_htrans_right. 
rw ntrans_ntdotted_fob. tv. am. am. am. 
Qed. 




Lemma full_pull_morphism_criterion : forall f a,
Category.axioms a ->
ob_iso f -> 
generates (target f) (add_inverses (target f) (mor_image f)) ->
full (pull_morphism a f).
Proof.
ir. 
assert (Functor.axioms f).
lu. 
assert (lem1: axioms (target f)).
uh H2; ee; am. 
uhg; ee. 
app pull_morphism_axioms.  

ir. 
uhg; ee. app pull_morphism_axioms. 

rwi target_pull_morphism H3. 
cp H3. rwi mor_functor_cat H6. uh H6; ee.
uh H4. uh H5. ee. clear H4. clear H5. 
nin H9; nin H10; ee. 

rwi source_pull_morphism H5. cp H5. 
rwi source_pull_morphism H4. cp H4. 
rwi fob_pull_morphism H10. 
rwi fob_pull_morphism H9. 
rwi ob_functor_cat H11; rwi ob_functor_cat H12. 
uh H11; uh H12; ee. 
assert (full_pull_situation f x0 x u).
uhg; ee; try am. 

sh (ntdotted f x0 x u).
ee. 
rw source_pull_morphism. rw mor_functor_cat. 
uhg; ee. app ntdotted_axioms. 
rw osource_ntdotted. am. 
rw otarget_ntdotted. am. 
am. am. 
rw fmor_pull_morphism. 
rw htrans_right_ntdotted. tv. 
am. 
rw mor_functor_cat. 
uhg; ee. app ntdotted_axioms. 
rw osource_ntdotted. am. 
rw otarget_ntdotted. am. 
am. am. am. am. am. am. am. am. 
am. am. am. am. 
am. am. am. am. uh H2; ee; am. am. 
Qed.





(** putting the above criteria together we get the 
main theorem of this module. Recall that 
the definition [iso_to_full_subcategory]
says that the functor is full, faithful, and injective on 
objects. This is equivalent to saying that it
induces an isomorphism to a full subcategory,
see Lemma [iso_to_full_subcategory_interp] above. **)

Lemma iso_to_full_subcategory_pull_morphism_criterion : forall f a,
Category.axioms a ->
ob_iso f -> 
generates (target f) (add_inverses (target f) (mor_image f)) ->
iso_to_full_subcategory (pull_morphism a f).
Proof.
ir. uhg; ee. 
ap faithful_pull_morphism_criterion. am. uh H0; ee; am. 
ap full_pull_morphism_criterion. am. am. am. 
ap ob_inj_pull_morphism_criterion. am. am. am. 
Qed.





End Ob_Iso_Functor.


Module Associating_Quotient.
Export Quotient_Category.
Export Quotient_Functor. 

(** We need a notion of taking the quotient of an object
which is like a category but isn't associative or
left and right unitary. This is to apply to the
left and right fraction constructions of localizations. 
The first task is therefore to divide up category axioms
into two parts; the first part called rqcat is for
``pre-quotient cat''. *)

Definition rqcat a :=
Category.Notations.like a &
(forall u, is_mor a u -> Arrow.like u) &
(forall x, is_ob a x -> is_mor a (id a x)) &
(forall x, is_ob a x -> source (id a x) = x) &
(forall x, is_ob a x -> target (id a x) = x) &
(forall u, is_mor a u -> is_ob a (source u)) &
(forall u, is_mor a u -> is_ob a (target u)) &
(forall u v, is_mor a u -> is_mor a v -> source u = target v ->
is_mor a (comp a u v)) &
(forall u v, is_mor a u -> is_mor a v -> source u = target v ->
source (comp a u v) = source v) &
(forall u v, is_mor a u -> is_mor a v -> source u = target v ->
target (comp a u v) = target u).


Lemma rq_is_ob_source : forall a u,
rqcat a -> is_mor a u -> is_ob a (source u).
Proof.
ir. uh H; ee. au. 
Qed.

Lemma rq_is_ob_target : forall a u,
rqcat a -> is_mor a u -> is_ob a (target u).
Proof.
ir. uh H; ee. au. 
Qed.

Lemma rq_is_mor_id : forall a x,
rqcat a -> is_ob a x -> is_mor a (id a x).
Proof.
ir. uh H; ee. au. 
Qed.

Lemma rq_source_id : forall a x,
rqcat a -> is_ob a x -> source (id a x) = x.
Proof.
ir. uh H; ee. au. 
Qed.

Lemma rq_target_id : forall a x,
rqcat a -> is_ob a x -> target (id a x) = x.
Proof.
ir. uh H; ee. au. 
Qed.

Lemma rq_is_mor_comp : forall a u v,
rqcat a -> is_mor a u -> is_mor a v -> source u = target v ->
is_mor a (comp a u v).
Proof.
ir. uh H; ee. au. 
Qed.

Lemma rq_source_comp : forall a u v,
rqcat a -> is_mor a u -> is_mor a v -> source u = target v ->
source (comp a u v) = source v.
Proof.
ir. uh H; ee. au. 
Qed.

Lemma rq_target_comp : forall a u v,
rqcat a -> is_mor a u -> is_mor a v -> source u = target v ->
target (comp a u v) = target u.
Proof.
ir. uh H; ee. au. 
Qed.


Definition left_id_ok  a :=
(forall u, is_mor a u -> comp a (id a (target u)) u = u).

Definition right_id_ok a :=
(forall u, is_mor a u -> comp a u (id a (source u)) = u).

Definition assoc_ok a :=
(forall u v w, is_mor a u -> is_mor a v -> is_mor a w ->
source u = target v -> source v = target w ->
comp a (comp a u v) w = comp a u (comp a v w)).

Lemma cat_axioms_rw_rq : forall a,
Category.axioms a = 
(rqcat a & left_id_ok a & right_id_ok a & assoc_ok a).
Proof.
ir. 
ap iff_eq; ir. 
ee. uhg; ee; ir. 
uh H; ee; am. apply mor_arrow_like with a. app is_mor_mor. 
ap mor_is_mor. ap mor_id. app is_ob_ob. 
rww source_id. app is_ob_ob. 
rww target_id. app is_ob_ob. 
ap ob_is_ob. rww ob_source. app is_mor_mor. 
ap ob_is_ob. rww ob_target. app is_mor_mor. 
ap mor_is_mor. rww mor_comp. 
app is_mor_mor. app is_mor_mor. 
rww source_comp. app is_mor_mor. app is_mor_mor. 
rww target_comp. app is_mor_mor. app is_mor_mor. 
uhg. ir. rww left_id. 
rww ob_target. app is_mor_mor. app is_mor_mor. 
uhg. ir. rww right_id. 
rww ob_source. app is_mor_mor. app is_mor_mor. 
uhg. 
ir. rww assoc. app is_mor_mor. 
app is_mor_mor. app is_mor_mor.



ee. uh H0. uh H1. uh H2.  
uhg; ee; ir; try (ap iff_eq; ir; uhg; ee). 
am. app rq_is_mor_id. rww rq_source_id. 
rww rq_target_id. 
ir. wr H5. ap H1. am. 
ir. wr H5. ap H0. am. uh H3; ee; am. am. 
app rq_is_ob_source. app rq_is_ob_target. 
ap H0. am. app H1. 
uh H; ee. au. uh H3; ee; am. am. 
uh H3; ee. app rq_is_mor_comp. 
uh H3; ee. rww rq_source_comp. 
uh H3; ee. rww rq_target_comp. 
uh H3; ee. uh H3; ee; am. 
uh H3; ee. uh H3; ee; am. 
uh H3; ee. uh H3; ee; am. 
uh H3; uh H4; ee. 
app H2. uh H; ee; am. 
Qed.

Definition rqcat_equiv_rel a r :=
rqcat a &
is_equivalence_relation r &
(forall x  y, related r x y -> is_mor a x) &
(forall x y, related r x y -> is_mor a y) &
(forall x y, related r x y -> source x = source y) &
(forall x y, related r x y -> target x = target y) &
(forall u, is_mor a u -> related r u u) &
(forall x y u v, related r x y -> related r u v ->
source x = target u ->
related r (comp a x u) (comp a y v)) &
(forall u, is_mor a u -> 
related r (comp a (id a (target u)) u) u)  &
(forall u, is_mor a u -> 
related r (comp a u (id a (source u))) u)  &
(forall u v w, is_mor a u -> is_mor a v -> is_mor a w ->
source u = target v -> source v = target w ->
related r (comp a (comp a u v) w) (comp a u (comp a v w))).


Lemma rq_inc_arrow_arrow_class : forall a r u v,
rqcat_equiv_rel a r -> is_mor a v ->
inc v (arrow (arrow_class r u)) = related r u v.
Proof.
ir. rw arrow_arrow_class. 
rww inc_class. lu. 
Qed.


Definition rq_quotient_arrow a r u :=
rqcat_equiv_rel a r & 
(exists y, is_mor a y & u = arrow_class r y).

Lemma rq_quotient_arrow_arrow_class : forall a r u,
rqcat_equiv_rel a r -> is_mor a u -> 
rq_quotient_arrow a r (arrow_class r u).
Proof.
ir. uhg; ee. am. sh u. ee; try tv; try am. 
Qed. 


Lemma rq_inc_quotient_morphisms : forall a r u,
rqcat_equiv_rel a r ->
inc u (quotient_morphisms a r) = rq_quotient_arrow a r u.
Proof.
ir. 
uf quotient_morphisms. 
rw Image.inc_rw. ap iff_eq; ir. 
nin H0. ee. 
wr H1. ap rq_quotient_arrow_arrow_class. am. am. 
uh H0; ee. nin H1. ee. sh x. ee. 
change (is_mor a x).  am. sy; am. 
Qed. 


Lemma rq_related_arrow_class_eq : forall a r u v,
rqcat_equiv_rel a r ->
is_mor a u -> 
related r u v =
(arrow_class r u = arrow_class r v).
Proof.
ir. 
ap iff_eq. ir. 
cp H0. assert (source u = source v).
uh H; ee. uh H; ee. au. 
assert (target u = target v).
uh H; ee. uh H; ee. au. 
rwi related_class_eq H1. 
uf arrow_class. rw H3; rw H4; rww H1. 
lu. ap transitive_ap. lu. 
sh v. ee; try am. ap symmetric_ap.
lu. am. 

ir. rw related_class_eq. wr arrow_arrow_class. 
rw H1. rw arrow_arrow_class. tv. lu. 
uh H; ee. au. 
Qed. 



Lemma rq_inc_arrow_class_refl : forall a r u,
rqcat_equiv_rel a r -> is_mor a u -> inc u (arrow (arrow_class r u)).
Proof.
ir. 
rw arrow_arrow_class. 
rw inc_class. uh H; ee. au. lu. 
Qed. 

Lemma rq_nonempty_arrow : forall a r u,
rq_quotient_arrow a r u -> 
nonempty (arrow u).
Proof.
ir. 
uh H; ee. nin H0. ee. rw H1. 
sh x. apply rq_inc_arrow_class_refl with a. am.
am. 
Qed. 

Lemma  rq_inc_arrow_rep_arrow : forall a r u,
rq_quotient_arrow a r u -> 
inc (arrow_rep u) (arrow u).
Proof.
ir. 
uf arrow_rep. 
ap nonempty_rep. apply rq_nonempty_arrow with a r. am. 
Qed. 

Lemma rq_related_arrow_rep_arrow_class : forall a r u,
rqcat_equiv_rel a r -> is_mor a u -> 
related r u (arrow_rep (arrow_class r u)).
Proof.
ir. 
wr inc_class. 
assert (class r u = arrow (arrow_class r u)).
rw arrow_arrow_class. tv. rw H1. 
apply rq_inc_arrow_rep_arrow with a r. 
ap rq_quotient_arrow_arrow_class. am. am. lu. 
Qed. 

Lemma rq_source_arrow_rep : forall a r u,
rq_quotient_arrow a r u -> source (arrow_rep u) = source u.
Proof.
ir. uh H; ee. nin H0. ee. 
cp (rq_related_arrow_rep_arrow_class H H0). 
wri H1 H2. 
transitivity (source x). 
uh H; ee. uh H; ee. sy; au. 

rw H1. rw source_arrow_class. tv. 
Qed. 

Lemma rq_target_arrow_rep : forall a r u,
rq_quotient_arrow a r u -> target (arrow_rep u) = target u.
Proof.
ir. uh H; ee. nin H0. ee. 
cp (rq_related_arrow_rep_arrow_class H H0). 
wri H1 H2. 
transitivity (target x). 
uh H; ee. uh H; ee. sy; au. 

rw H1. rw target_arrow_class. tv. 
Qed. 

Lemma rq_arrow_class_arrow_rep : forall a r u,
rq_quotient_arrow a r u ->
arrow_class r (arrow_rep u) = u. 
Proof. 
ir. 
uh H; ee. nin H0. ee. 
rw H1. sy. 
rewrite <- rq_related_arrow_class_eq with (a:=a). 
apply rq_related_arrow_rep_arrow_class with (a:=a).
am. am. am. am.  
Qed.

Lemma rq_inc_arrow_facts : forall a r u y,
rq_quotient_arrow a r u -> inc y (arrow u) ->
(is_mor a y & source y = source u & target y = target u).
Proof.
ir.
uh H; ee. nin H1. ee. rwi H2 H0. 
rwi arrow_arrow_class H0. rwi inc_class H0. 
uh H; ee. uh H; ee. 
apply H5 with x. am. lu. 

nin H1. ee. rwi H2 H0. 
rwi arrow_arrow_class H0. rwi inc_class H0. 
transitivity (source x). 

uh H; ee. uh H; ee. sy; au. rw H2. 
rww source_arrow_class. lu. 

nin H1. ee. rwi H2 H0. 
rwi arrow_arrow_class H0. rwi inc_class H0. 
transitivity (target x). 

uh H; ee. uh H; ee. sy; au. rw H2. 
rww target_arrow_class. lu. 
Qed. 

Lemma rq_mor_arrow_rep : forall a r u,
rq_quotient_arrow a r u ->
is_mor a (arrow_rep u).
Proof.
ir. 
uh H; ee. 
nin H0; ee. rw H1. 
cp (rq_related_arrow_rep_arrow_class H H0). 
uh H; ee. 
uh H; ee. apply H5 with x. am. 
Qed.

Lemma rq_related_arrow_rep : forall a r u v,
rqcat_equiv_rel a r -> is_mor a v -> u = arrow_class r v ->
related r v (arrow_rep u).
Proof.
ir. rw H1. 
apply rq_related_arrow_rep_arrow_class with a. am. am. 
Qed. 


Lemma rq_related_arrow_rep_rw : forall a r u v,
rqcat_equiv_rel a r -> rq_quotient_arrow a r u -> is_mor a v -> 
related r v (arrow_rep u) = (u = arrow_class r v).
Proof.
ir. 
ap iff_eq; ir. 
cp H0. uh H3; ee. nin H4. ee. rw H5. 
rewrite <- rq_related_arrow_class_eq with (a:=a). 
ap transitive_ap. lu. 
sh (arrow_rep u). ee. rw H5. 
apply rq_related_arrow_rep_arrow_class with a. am. 
am. ap symmetric_ap. lu. am. 
am. am. rw H2. 
apply rq_related_arrow_rep_arrow_class with a. am. 
am. 
Qed. 



Lemma rq_source_quot_comp : forall a r u v,
rqcat_equiv_rel a r ->
rq_quotient_arrow a r u ->
rq_quotient_arrow a r v -> source u = target v ->
source (quot_comp a r u v) = source v.
Proof.
ir. 
uf quot_comp. 
rw source_arrow_class. rw rq_source_comp. 
rewrite rq_source_arrow_rep with (a:=a)(r:=r). tv.
am. 
lu. 
apply rq_mor_arrow_rep with r. am. 
apply rq_mor_arrow_rep with r. am. 
rewrite rq_source_arrow_rep with (a:=a)(r:=r). 
rewrite rq_target_arrow_rep with (a:=a)(r:=r). 
am. am. am. 
Qed. 

Lemma rq_target_quot_comp : forall a r u v,
rqcat_equiv_rel a r ->
rq_quotient_arrow a r u ->
rq_quotient_arrow a r v -> source u = target v ->
target (quot_comp a r u v) = target u.
Proof.
ir. 
uf quot_comp. 
rw target_arrow_class. rw rq_target_comp. 
rewrite rq_target_arrow_rep with (a:=a)(r:=r). tv.
am. lu. 
apply rq_mor_arrow_rep with r. am. 
apply rq_mor_arrow_rep with r. am. 
rewrite rq_source_arrow_rep with (a:=a)(r:=r). 
rewrite rq_target_arrow_rep with (a:=a)(r:=r). 
am. am. am. 
Qed. 

Lemma rq_quotient_arrow_quot_id : forall a r x,
rqcat_equiv_rel a r -> is_ob a x ->
rq_quotient_arrow a r (quot_id a r x).
Proof.
ir. 
uf quot_id. 
ap rq_quotient_arrow_arrow_class. am. 
app rq_is_mor_id. lu. 
Qed.

Lemma rq_quotient_arrow_quot_comp : forall a r u v,
rqcat_equiv_rel a r -> rq_quotient_arrow a r u -> 
rq_quotient_arrow a r v 
-> source u = target v ->
rq_quotient_arrow a r (quot_comp a r u v).
Proof.
ir. uf quot_comp. 
ap rq_quotient_arrow_arrow_class.
am. 
app rq_is_mor_comp. lu. 
apply rq_mor_arrow_rep with r. am. 
apply rq_mor_arrow_rep with r. am.
rewrite rq_source_arrow_rep with (a:=a)(r:=r). 
rewrite rq_target_arrow_rep with (a:=a)(r:=r). 
am. am. am. 
Qed. 

Lemma rq_arrow_class_eq : forall a r u v,
rqcat_equiv_rel a r -> is_mor a u ->  
(arrow_class r u = arrow_class r v) = 
(related r u v).
Proof.
ir. 
sy. ap (rq_related_arrow_class_eq (a:=a)). am. am. 
Qed. 

 
Lemma rq_related_comp : forall a r x y u v,
rqcat_equiv_rel a r -> 
related r x y -> related r u v -> source x = target u ->
related r (comp a x u) (comp a y v).
Proof.
ir. uh H; ee. au. 
Qed. 



Lemma rq_quot_comp_arrow_class : forall a r u v,
rqcat_equiv_rel a r -> is_mor a u -> is_mor a v -> 
source u = target v ->
quot_comp a r (arrow_class r u) (arrow_class r v) = 
arrow_class r (comp a u v).
Proof.
ir. 
uf quot_comp. 
rewrite rq_arrow_class_eq with (a:=a). 
ap rq_related_comp. am. 
ap symmetric_ap. lu. 
ap (rq_related_arrow_rep_arrow_class (a:=a)). 
am. am. 
ap symmetric_ap. lu. 
ap (rq_related_arrow_rep_arrow_class (a:=a)). 
am. am. 

rewrite rq_source_arrow_rep with (a:=a)(r:=r). 
rewrite rq_target_arrow_rep with (a:=a)(r:=r). 
rw source_arrow_class. 
rww target_arrow_class. 

app rq_quotient_arrow_arrow_class. 
app rq_quotient_arrow_arrow_class. 
am. 

ap rq_is_mor_comp. lu. 
ap (rq_mor_arrow_rep (a:=a)(r:=r)). 
app rq_quotient_arrow_arrow_class. 
ap (rq_mor_arrow_rep (a:=a)(r:=r)). 
app rq_quotient_arrow_arrow_class. 

rewrite rq_source_arrow_rep with (a:=a)(r:=r). 
rewrite rq_target_arrow_rep with (a:=a)(r:=r). 
rw source_arrow_class. 
rww target_arrow_class. 

app rq_quotient_arrow_arrow_class. 
app rq_quotient_arrow_arrow_class. 
Qed. 


Lemma rq_left_id_related : forall a r u,
rqcat_equiv_rel a r -> 
is_mor a u -> 
related r (comp a (id a (target u )) u) u.
Proof.
ir. uh H; ee. au. 
Qed.

Lemma rq_right_id_related : forall a r u,
rqcat_equiv_rel a r -> 
is_mor a u -> 
related r (comp a u (id a (source u ))) u.
Proof.
ir. uh H; ee. au. 
Qed.


Lemma rq_assoc_related : forall a r u v w,
rqcat_equiv_rel a r -> 
is_mor a u -> is_mor a v -> is_mor a w ->
source u = target v -> source v = target w ->
related r (comp a (comp a u v) w) (comp a u (comp a v w)).
Proof.
ir. uh H; ee. au.
Qed. 

Lemma rq_quot_id_left : forall a r a' r' x u,
rqcat_equiv_rel a r -> rq_quotient_arrow a r u ->
x = target u -> a' = a -> r' = r ->
quot_comp a r (quot_id a' r' x) u = u.
Proof.
ir. 
rw H2; rw H3. 

uh H0; ee. nin H4; ee. rw H5. 
uf quot_id. 

assert (target u = target x0). 
rw H5. 
rewrite target_arrow_class. tv. 
assert (is_ob a x). 
rw H1; rw H6.
app rq_is_ob_target. lu. 


rw rq_quot_comp_arrow_class. 
rewrite <- rq_related_arrow_class_eq with (a:=a). 
rw H1. rw H6. app rq_left_id_related. 
am. ap rq_is_mor_comp. lu. 
ap rq_is_mor_id. lu. am. am. 
rww rq_source_id. rw H1. am. lu. am. 
ap rq_is_mor_id. lu. am. am. 
rww rq_source_id. rw H1. am. lu. 
Qed. 

Lemma rq_quot_id_right : forall a r a' r' x u,
rqcat_equiv_rel a r -> rq_quotient_arrow a r u ->
x = source u -> a' = a -> r' = r ->
quot_comp a r u (quot_id a' r' x) = u.
Proof.
ir. 
rw H2; rw H3. 

uh H0; ee. nin H4; ee. rw H5. 
uf quot_id. 

assert (source u = source x0). 
rw H5. 
rewrite source_arrow_class. tv. 
assert (is_ob a x). 
rw H1; rw H6.
app rq_is_ob_source. lu. 


rw rq_quot_comp_arrow_class. 
rewrite <- rq_related_arrow_class_eq with (a:=a). 
rw H1. rw H6. app rq_right_id_related. 
am. ap rq_is_mor_comp. lu. 
am. ap rq_is_mor_id. lu. am. 
rww rq_target_id. rw H1. sy; am. lu. am. 
am. ap rq_is_mor_id. lu. am. 
rww rq_target_id. rw H1. sy; am. lu. 
Qed. 

Lemma rq_quot_comp_assoc : forall a r a' r' u v w,
rqcat_equiv_rel a r ->  rq_quotient_arrow a r u -> 
rq_quotient_arrow a r v 
-> rq_quotient_arrow a r w -> source u = target v ->
source v = target w -> a' = a -> r' = r -> 
quot_comp a r (quot_comp a' r' u v) w = quot_comp a r u (quot_comp a' r' v w).
Proof.
ir. rw H5; rw H6. clear H5 H6. 

uh H0; uh H1; uh H2; ee. 
nin H7; nin H6; nin H5; ee.
clear H0 H1 H2. 


assert (source x = target x0). 
transitivity (source u). 
rw H10. 
rww source_arrow_class. 
rw H3. rw H9. rww target_arrow_class. 

assert (source x0 = target x1). 
transitivity (source v). 
rw H9. 
rww source_arrow_class. 
rw H4. rw H8. rww target_arrow_class. 


rw H10; rw H9; rw H8. 
rw rq_quot_comp_arrow_class. 
rw rq_quot_comp_arrow_class. 
rw rq_quot_comp_arrow_class.
rw rq_quot_comp_arrow_class.

rewrite <- rq_related_arrow_class_eq with (a:=a). 
ap rq_assoc_related. 
am. am. am. am. am. am. am. 

app rq_is_mor_comp. lu. 
app rq_is_mor_comp. lu. 
rw rq_source_comp. am. lu. 
am. am. am. am. am. 
app rq_is_mor_comp. lu. 
rww rq_target_comp. lu. 
am. am. am. am. am. 
app rq_is_mor_comp. lu. am. 
rww rq_source_comp. lu. am. am. am. am. 
Qed. 


Lemma rq_is_mor_quotient_cat : forall a r u,
rqcat_equiv_rel a r -> 
is_mor (quotient_cat a r) u = rq_quotient_arrow a r u.
Proof.
ir. 
uf quotient_cat. rw is_mor_create. 
rww rq_inc_quotient_morphisms. 
Qed.

Lemma rq_comp_quotient_cat : forall a r u v,
rqcat_equiv_rel a r -> rq_quotient_arrow a r u ->
rq_quotient_arrow a r v ->
source u = target v -> 
comp (quotient_cat a r) u v = quot_comp a r u v.
Proof.
ir. 
uf quotient_cat. 
rw comp_create. tv. 
rww rq_inc_quotient_morphisms. 
rww rq_inc_quotient_morphisms. am. 
Qed. 

Lemma rq_id_quotient_cat : forall a r x,
rqcat_equiv_rel a r -> is_ob a x -> 
id (quotient_cat a r) x = quot_id a r x.
Proof.
ir. uf quotient_cat. rw id_create. tv. am. 
Qed. 


Lemma rq_source_quot_id : forall a r x,
rqcat_equiv_rel a r -> is_ob a x -> 
source (quot_id a r x) = x.
Proof.
ir. 
uf quot_id. rw source_arrow_class. 
uh H; ee. uh H; ee. ap H13. am. 
Qed. 


Lemma rq_target_quot_id : forall a r x,
rqcat_equiv_rel a r -> is_ob a x -> 
target (quot_id a r x) = x.
Proof.
ir. 
uf quot_id. rw target_arrow_class. 
uh H; ee. uh H; ee. ap H14. am. 
Qed. 


Lemma rqcat_quotient_cat : forall a r,
rqcat_equiv_rel a r -> 
rqcat (quotient_cat a r).
Proof.
ir. 
uhg; ee; ir. 
uf quotient_cat. 
ap Category.Notations.create_like. 
rwi rq_is_mor_quotient_cat H0. 
uh H0; ee. nin H1. ee. rw H2. 
uf arrow_class. 
rww Arrow.create_like. am. 

rwi is_ob_quotient_cat H0. 
rww rq_id_quotient_cat. 
rww rq_is_mor_quotient_cat. 
app rq_quotient_arrow_quot_id. 

rwi is_ob_quotient_cat H0. 
rww rq_id_quotient_cat. rww rq_source_quot_id. 

rwi is_ob_quotient_cat H0. 
rww rq_id_quotient_cat. rww rq_target_quot_id. 

rw is_ob_quotient_cat. 
rwi rq_is_mor_quotient_cat H0. 
uh H0; ee. nin H1. ee. rw H2. 
rw source_arrow_class. 
ap rq_is_ob_source. lu. am. am. 

rw is_ob_quotient_cat. 
rwi rq_is_mor_quotient_cat H0. 
uh H0; ee. nin H1. ee. rw H2. 
rw target_arrow_class. 
ap rq_is_ob_target. lu. am. am. 

rwi rq_is_mor_quotient_cat H0. 
rwi rq_is_mor_quotient_cat H1. 
rww rq_is_mor_quotient_cat. 
rww rq_comp_quotient_cat. 
app rq_quotient_arrow_quot_comp. am. am. 


rwi rq_is_mor_quotient_cat H0. 
rwi rq_is_mor_quotient_cat H1. 
rww rq_comp_quotient_cat. 
rww rq_source_quot_comp. am. am. 

rwi rq_is_mor_quotient_cat H0. 
rwi rq_is_mor_quotient_cat H1. 
rww rq_comp_quotient_cat. 
rww rq_target_quot_comp. am. am. 
Qed.

Lemma rq_quotient_cat_axioms : forall a r,
rqcat_equiv_rel a r -> Category.axioms (quotient_cat a r).
Proof.
ir. 
rw cat_axioms_rw_rq. 
ee. ap rqcat_quotient_cat. am. 


uhg. ir. 
rwi rq_is_mor_quotient_cat H0. 
assert (is_ob a (target u)). 
uh H0; ee. nin H1. ee. rw H2. 
rw target_arrow_class. 
app rq_is_ob_target. lu. 

rww rq_comp_quotient_cat. 
rww rq_id_quotient_cat. 
rww rq_quot_id_left. 


rww rq_id_quotient_cat. 
app rq_quotient_arrow_quot_id. 
rww rq_id_quotient_cat. 
rww rq_source_quot_id. am. 


uhg. ir. 
rwi rq_is_mor_quotient_cat H0. 
assert (is_ob a (source u)). 
uh H0; ee. nin H1. ee. rw H2. 
rw source_arrow_class. 
app rq_is_ob_source. lu. 

rww rq_comp_quotient_cat. 
rww rq_id_quotient_cat. 
rww rq_quot_id_right. 


rww rq_id_quotient_cat. 
app rq_quotient_arrow_quot_id. 
rww rq_id_quotient_cat. 
rww rq_target_quot_id. am. 

uhg; ir. 
rwi rq_is_mor_quotient_cat H0; try am. 
rwi rq_is_mor_quotient_cat H1; try am. 
rwi rq_is_mor_quotient_cat H2; try am. 

rww rq_comp_quotient_cat. rww rq_comp_quotient_cat.
rww rq_quot_comp_assoc. 
sy. 
rw rq_comp_quotient_cat. rw rq_comp_quotient_cat.
tv. am. am. am. am. am. am. 

rww rq_comp_quotient_cat. 
app rq_quotient_arrow_quot_comp. 
rww rq_comp_quotient_cat. 
rww rq_target_quot_comp. 

rww rq_comp_quotient_cat. 
app rq_quotient_arrow_quot_comp. 
rww rq_comp_quotient_cat. 
rww rq_source_quot_comp. 
Qed. 

Lemma rq_ob_quotient_cat : forall a r x,
rqcat_equiv_rel a r -> 
ob (quotient_cat a r) x = is_ob a x.
Proof.
ir. 
ap iff_eq; ir. uh H0; ee. 
rwi is_ob_quotient_cat H1. am.
uhg. ee. ap rq_quotient_cat_axioms. am. 
rw is_ob_quotient_cat. am. 
Qed.

Lemma rq_mor_quotient_cat : forall a r u,
rqcat_equiv_rel a r ->
mor (quotient_cat a r) u = rq_quotient_arrow a r u.
Proof. 
ir. 
ap iff_eq; ir. uh H0; ee. 
rwi rq_is_mor_quotient_cat H1. am. am. 
uhg; ee. ap rq_quotient_cat_axioms. am. 
rww rq_is_mor_quotient_cat. 
Qed. 

Lemma rq_mor_quotient_cat_ex : forall a r u,
rqcat_equiv_rel a r ->
mor (quotient_cat a r) u = 
(exists y, is_mor a y & u = arrow_class r y).
Proof.
ir. rww rq_mor_quotient_cat. 
ap iff_eq; ir. uh H0; ee. am. uhg; ee. 
am. am. 
Qed.

Lemma rq_mor_quotient_cat_quot_id : forall a r x,
rqcat_equiv_rel a r -> is_ob a x -> 
mor (quotient_cat a r) (quot_id a r x).
Proof.
ir. rw rq_mor_quotient_cat.
app rq_quotient_arrow_quot_id. am. 
Qed.

Lemma rq_mor_quotient_cat_quot_comp : forall a r u v,
rqcat_equiv_rel a r ->
mor (quotient_cat a r) u ->
mor (quotient_cat a r) v ->
source u = target v ->
mor (quotient_cat a r) (quot_comp a r u v).
Proof.
ir. 
rwi rq_mor_quotient_cat H0. 
rwi rq_mor_quotient_cat H1. 
rw rq_mor_quotient_cat. 
ap rq_quotient_arrow_quot_comp. am. 
am. am. am. am. am. am. 
Qed. 

Lemma rq_mor_quotient_cat_arrow_class : forall a r u,
rqcat_equiv_rel a r -> is_mor a u ->
mor (quotient_cat a r) (arrow_class r u).
Proof.
ir. rw rq_mor_quotient_cat. 
ap rq_quotient_arrow_arrow_class. am. am. am. 
Qed. 

(** Now we look at how to define a functor into 
a quotient in the above sense; the basic notation 
is the same as [qfunctor] in [qcat.v]. *)



Definition rqfunctor_property a b r fo fm :=
Category.axioms a &
rqcat_equiv_rel b r &
(forall x, ob a x -> is_ob b (fo x)) &
(forall u, mor a u -> is_mor b (fm u)) &
(forall u, mor a u -> source (fm u) = fo (source u)) &
(forall u, mor a u -> target (fm u) = fo (target u)) &
(forall x, ob a x -> related r (fm (id a x)) (id b (fo x))) &
(forall u v, mor a u -> mor a v -> source u = target v ->
related r (fm (comp a u v)) (comp b (fm u) (fm v))).

Lemma rq_fob_qfunctor : forall a b r fo fm x,
rqfunctor_property a b r fo fm -> ob a x ->
fob (qfunctor a b r fo fm) x = fo x.
Proof.
ir. 
uf fob. rw fmor_qfunctor. rw source_arrow_class. 
rw source_qfunctor. uh H; ee. 
rw H4. rww source_id. app mor_id. 
rw source_qfunctor. app mor_id. 
Qed. 

Lemma rq_ob_fob_qfunctor : forall a b r fo fm x, 
rqfunctor_property a b r fo fm -> ob a x ->
ob (quotient_cat b r) (fob (qfunctor a b r fo fm) x).
Proof.
ir. 
rww rq_fob_qfunctor. 
rw rq_ob_quotient_cat. uh H; ee; au. uh H; ee; am. 
Qed.

Lemma rq_mor_fmor_qfunctor : forall a b r fo fm u, 
rqfunctor_property a b r fo fm -> mor a u ->
mor (quotient_cat b r) (fmor (qfunctor a b r fo fm) u).
Proof.
ir. 
rww fmor_qfunctor. rww rq_mor_quotient_cat. 
ap rq_quotient_arrow_arrow_class. lu. 
uh H; ee; au. lu. 
Qed.

Lemma rq_source_fmor_qfunctor : forall a b r fo fm u,
rqfunctor_property a b r fo fm -> mor a u ->
source (fmor (qfunctor a b r fo fm) u) = fob (qfunctor a b r fo fm) (source u).
Proof.
ir. 
rw fmor_qfunctor. rw source_arrow_class.
rww rq_fob_qfunctor. uh H; ee; au. rww ob_source. am. 
Qed. 

Lemma rq_target_fmor_qfunctor : forall a b r fo fm u,
rqfunctor_property a b r fo fm -> mor a u ->
target (fmor (qfunctor a b r fo fm) u) = fob (qfunctor a b r fo fm) (target u).
Proof.
ir. 
rw fmor_qfunctor. rw target_arrow_class.
rww rq_fob_qfunctor. uh H; ee; au. rww ob_target. am. 
Qed. 

Lemma rq_fmor_qfunctor_id : forall a b r fo fm x, 
rqfunctor_property a b r fo fm -> ob a x ->
fmor (qfunctor a b r fo fm) (id a x) = 
id (quotient_cat b r) (fob (qfunctor a b r fo fm) x).
Proof.
ir. rw fmor_qfunctor. 
rw rq_id_quotient_cat. 
rw rq_fob_qfunctor. uf quot_id. 
rewrite <- rq_related_arrow_class_eq with (a:=b). 
uh H; ee; au. lu. 
assert (mor a (id a x)). app  mor_id. 
uh H; ee; au. am. am. lu. 
rww rq_fob_qfunctor. uh H; ee; au. app mor_id. 
Qed.

Lemma rq_fmor_qfunctor_comp : forall a b r fo fm u v,
rqfunctor_property a b r fo fm -> mor a u ->
mor a v -> source u = target v ->
fmor (qfunctor a b r fo fm) (comp a u v) =
comp (quotient_cat b r) (fmor (qfunctor a b r fo fm) u) 
(fmor (qfunctor a b r fo fm) v).
Proof.
ir. 
assert (rqcat_equiv_rel b r). lu. 
rww fmor_qfunctor. rww fmor_qfunctor. 
rww fmor_qfunctor. 
rw rq_comp_quotient_cat. 
rw rq_quot_comp_arrow_class. 
rewrite <- rq_related_arrow_class_eq with (a:=b). 
uh H; ee; au. am. 
assert (mor a (comp a u v)). 
rww mor_comp. 
uh H; ee; au. am. 
uh H; ee; au. 
uh H; ee; au. 
uh H; ee. rww H7; rww H8. rww H2. 
am. 
app rq_quotient_arrow_arrow_class. 
uh H; ee; au. 
app rq_quotient_arrow_arrow_class. 
uh H; ee; au. 
rw source_arrow_class. rw target_arrow_class.
uh H; ee. rww H7; rww H8. rww H2. 
rww mor_comp. 
Qed.

Lemma qfunctor_axioms : forall a b r fo fm,
rqfunctor_property a b r fo fm -> 
Functor.axioms (qfunctor a b r fo fm).
Proof.
ir. 
uhg; ee. 
uf qfunctor. uf Functor.create. 
ap Umorphism.create_like. 
rw source_qfunctor. lu. 
rw target_qfunctor. ap rq_quotient_cat_axioms. 
lu. 

ir. rwi source_qfunctor H0. 
rw target_qfunctor. app rq_ob_fob_qfunctor. 

ir. rwi source_qfunctor H0. 
rw target_qfunctor. 
rw source_qfunctor. 
sy; app rq_fmor_qfunctor_id. 

ir. rwi source_qfunctor H0. 
rw target_qfunctor. 
app  rq_mor_fmor_qfunctor. 

ir. rwi source_qfunctor H0. 
rww rq_source_fmor_qfunctor. 

ir. rwi source_qfunctor H0. 
rww rq_target_fmor_qfunctor. 

ir. rwi source_qfunctor H0. 
rwi source_qfunctor H1. 
rw target_qfunctor. 
rw source_qfunctor. 
sy; app rq_fmor_qfunctor_comp. 
Qed. 

End Associating_Quotient.



(*****************************************************************************************)
(*****************************************************************************************)
(*****************************************************************************************)
(*****************************************************************************************)

Module GZ_Def.
Export Free_Category.
Export Quotient_Functor.

Definition Forward := R (f_(o_(r_ DOT))).
Definition Backward := R (b_(k_(d_ DOT))).

Definition forward_arrow u :=
Arrow.create (source u) (target u) (pair Forward u).

Definition backward_arrow u :=
Arrow.create (target u) (source u) (pair Backward u).

Lemma source_forward_arrow : forall u,
source (forward_arrow u) = source u.
Proof.
ir. uf forward_arrow. rww Arrow.source_create. 
Qed.

Lemma target_forward_arrow : forall u,
target (forward_arrow u) = target u.
Proof.
ir. uf forward_arrow. rww Arrow.target_create. 
Qed.

Lemma source_backward_arrow : forall u,
source (backward_arrow u) = target u.
Proof.
ir. uf backward_arrow. rww Arrow.source_create. 
Qed.

Lemma target_backward_arrow : forall u,
target (backward_arrow u) = source u.
Proof.
ir. uf backward_arrow. rww Arrow.target_create. 
Qed.

Definition original_arrow u := pr2 (arrow u).

Lemma original_arrow_forward_arrow : forall u,
original_arrow (forward_arrow u) = u.
Proof.
ir. uf forward_arrow. uf original_arrow.
rw Arrow.arrow_create. rww pr2_pair. 
Qed. 

Lemma original_arrow_backward_arrow : forall u,
original_arrow (backward_arrow u) = u.
Proof.
ir. uf backward_arrow. uf original_arrow.
rw Arrow.arrow_create. rww pr2_pair. 
Qed.

Definition direction u := pr1 (arrow u).

Lemma direction_forward_arrow : forall u,
direction (forward_arrow u) = Forward.
Proof.
ir. uf forward_arrow. uf direction.
rw Arrow.arrow_create. rww pr1_pair. 
Qed.

Lemma direction_backward_arrow : forall u,
direction (backward_arrow u) = Backward.
Proof.
ir. uf backward_arrow. uf direction.
rw Arrow.arrow_create. rww pr1_pair. 
Qed.

Definition localizing_system a s :=
Category.axioms a &
(forall u, inc u s -> mor a u).


Definition loc_edges a s := 
union2 (Image.create (morphisms a) forward_arrow) (Image.create s backward_arrow).

Lemma inc_loc_edges : forall a s u,
localizing_system a s ->
inc u (loc_edges a s) = 
((exists y, (mor a y & u = forward_arrow y)) \/
(exists y, (mor a y & inc y s & u = backward_arrow y))).
Proof.
ir. 
ap iff_eq; ir. 
ufi loc_edges H0. 
cp (union2_or H0). 
nin H1. ap or_introl. 
rwi Image.inc_rw H1. nin H1. ee. 
sh x. ee. app is_mor_mor. uh H; ee; am.
sy; am. 
ap or_intror.
rwi Image.inc_rw H1. nin H1. ee. 
sh x. ee. 
uh H; ee. ap H3. am. am. sy; am. 
uf loc_edges. 
nin H0. ap union2_first. 
rw Image.inc_rw. nin H0. sh x; ee. 
app mor_is_mor. sy; am. 
ap union2_second. rw Image.inc_rw. 
nin H0. sh x; ee. am. sy; am. 
Qed.

Definition gz_graph a s := Graph.create (objects a) (loc_edges a s).

Lemma inc_vertices_gz_graph : forall a s x,
localizing_system a s ->
inc x (vertices (gz_graph a s)) = ob a x.
Proof.
ir. 
uf gz_graph. 
rw vertices_create. ap iff_eq; ir. 
ap is_ob_ob. uh H; ee; am. am. app ob_is_ob. 
Qed.

Lemma inc_edges_gz_graph : forall a s u,
localizing_system a s ->
inc u (edges (gz_graph a s)) = inc u (loc_edges a s).
Proof.
ir. uf gz_graph. rw edges_create. tv. 
Qed.


Lemma gz_graph_axioms : forall a s,
localizing_system a s -> Graph.axioms (gz_graph a s).
Proof.
ir. 
uhg; ee. uf gz_graph. ap Graph.create_like. 
ir. rwi inc_edges_gz_graph H0. 
rwi inc_loc_edges H0. nin H0. 
nin H0. ee. rw H1. 
uf forward_arrow. rww Arrow.create_like. 
nin H0. ee. rw H2. uf backward_arrow. 
rww Arrow.create_like. am. am. 

ir. rwi inc_edges_gz_graph H0. 
rw inc_vertices_gz_graph. 
rwi inc_loc_edges H0. nin H0. 
nin H0. ee. rw H1. rw source_forward_arrow.
rww ob_source. 
nin H0. ee. rw H2. rw source_backward_arrow. 
rww ob_target. am. am. am. 

ir. rwi inc_edges_gz_graph H0. 
rw inc_vertices_gz_graph. 
rwi inc_loc_edges H0. nin H0. 
nin H0. ee. rw H1. rw target_forward_arrow.
rww ob_target. 
nin H0. ee. rw H2. rw target_backward_arrow. 
rww ob_source. am. am. am. 
Qed.

Definition gz_freecat a s := freecat (gz_graph a s).

Lemma gz_freecat_axioms  : forall a s,
localizing_system a s -> Category.axioms (gz_freecat a s).
Proof.
ir. uf gz_freecat. app freecat_axioms. 
app gz_graph_axioms. 
Qed.

Lemma ob_gz_freecat : forall a s x, 
localizing_system a s -> 
ob (gz_freecat a s) x = ob a x.
Proof.
ir. 
uf gz_freecat. rw ob_freecat_rw. 
rw inc_vertices_gz_graph. tv. am. 
app gz_graph_axioms. 
Qed.

Lemma mor_gz_freecat : forall a s u,
localizing_system a s ->
mor (gz_freecat a s) u = mor_freecat (gz_graph a s) u.
Proof.
ir. 
uf gz_freecat. rw mor_freecat_rw. 
tv. app gz_graph_axioms. 
Qed.

Lemma comp_gz_freecat : forall a s u v,
localizing_system a s ->
mor (gz_freecat a s) u ->
mor (gz_freecat a s) v ->
source u = target v ->
comp (gz_freecat a s) u v = freecat_comp u v.
Proof.
ir. 
uf gz_freecat. rw comp_freecat. tv. 
ap gz_graph_axioms. am. am. am. am. 
Qed.

Lemma id_gz_freecat : forall a s x,
localizing_system a s ->
ob a x -> id (gz_freecat a s) x = freecat_id x.
Proof.
ir. uf gz_freecat. rww id_freecat. 
app gz_graph_axioms. 
rw ob_freecat_rw. rww inc_vertices_gz_graph. 
app gz_graph_axioms. 
Qed.



Definition forward_edge u :=
freecat_edge (forward_arrow u).

Definition backward_edge u :=
freecat_edge (backward_arrow u).

Lemma source_forward_edge : forall u,
source (forward_edge u) = source u.
Proof.
ir. uf forward_edge. rw source_freecat_edge.
rww source_forward_arrow. 
Qed.

Lemma target_forward_edge : forall u,
target (forward_edge u) = target u.
Proof.
ir. uf forward_edge. rw target_freecat_edge.
rww target_forward_arrow. 
Qed.

Lemma source_backward_edge : forall u,
source (backward_edge u) = target u.
Proof.
ir. uf backward_edge. rw source_freecat_edge.
rww source_backward_arrow. 
Qed.

Lemma target_backward_edge : forall u,
target (backward_edge u) = source u.
Proof.
ir. uf backward_edge. rw target_freecat_edge.
rww target_backward_arrow. 
Qed.

Lemma inc_forward_arrow_loc_edges : forall a s u,
localizing_system a s ->mor a u -> 
inc (forward_arrow u) (loc_edges a s).
Proof.
ir. rw inc_loc_edges. 
ap or_introl. sh u. ee. am. tv. am. 
Qed. 

Lemma inc_backward_arrow_loc_edges : forall a s q,
localizing_system a s ->inc q s -> 
inc (backward_arrow q) (loc_edges a s).
Proof.
ir. rw inc_loc_edges. ap or_intror. 
sh q. ee. 
uh H; ee; au. am. tv. am. 
Qed. 

Lemma mor_forward_edge : forall a s u,
localizing_system a s ->
mor a u -> mor (gz_freecat a s) (forward_edge u).
Proof.
ir. 
uf forward_edge. 
rw mor_gz_freecat. 
ap mor_freecat_edge. 
app gz_graph_axioms. 
rw inc_edges_gz_graph. 
app inc_forward_arrow_loc_edges. am. am. 
Qed.

Lemma mor_backward_edge : forall a s q,
localizing_system a s ->
inc q s -> mor (gz_freecat a s) (backward_edge q).
Proof.
ir. 
uf backward_edge. 
rw mor_gz_freecat. 
ap mor_freecat_edge. 
app gz_graph_axioms. 
rw inc_edges_gz_graph. 
app inc_backward_arrow_loc_edges. am. am. 
Qed.



Definition gz_rel a s :=
Z (coarse (gz_freecat a s))
(fun z =>
((exists x, (ob a x & 
z = pair (forward_edge (id a x)) (freecat_id x))) \/
(exists q, (inc q s & z = pair 
(freecat_comp (forward_edge q) (backward_edge q)) 
(freecat_id (target q)))) \/
(exists q, (inc q s & z = pair 
(freecat_comp (backward_edge q) (forward_edge q)) 
(freecat_id (source q)))) \/
(exists u, exists v, (mor a u & mor a v & source u = target v &
z = pair (freecat_comp (forward_edge u) (forward_edge v))
(forward_edge (comp a u v)))))).


Lemma inc_coarse : forall a z,
Category.axioms a -> 
inc z (coarse a) =
(exists u, exists v, (mor a u & mor a v & source u = source v 
& target u = target v & z=pair u v)).
Proof.
ir. ap iff_eq; ir. ufi coarse H0. 
Ztac. cp (product_pr H1). 
ee. rwi is_pair_rw H4. 
sh (pr1 z). sh (pr2 z). 
ee. ap is_mor_mor. am. am. ap is_mor_mor.
am. am. am. am. am. 
nin H0. nin H0. 
ee. rw H4. uf coarse. Ztac. 
ap product_inc. ap pair_is_pair. 
rw pr1_pair. app mor_is_mor. rw pr2_pair. 
app mor_is_mor. rw pr1_pair. rw pr2_pair. 
ee; am. 
Qed. 

Lemma inc_gz_rel : forall a s z,
localizing_system a s -> 
inc z (gz_rel a s) = 
((exists x, (ob a x & 
z = pair (forward_edge (id a x)) (freecat_id x)))\/
(exists q, (inc q s & z = pair 
(freecat_comp (forward_edge q) (backward_edge q)) 
(freecat_id (target q))))\/
(exists q, (inc q s & z = pair 
(freecat_comp (backward_edge q) (forward_edge q)) 
(freecat_id (source q))))\/
(exists u, exists v, (mor a u & mor a v & source u = target v &
z = pair (freecat_comp (forward_edge u) (forward_edge v))
(forward_edge (comp a u v))))).
Proof.
ir. 
assert (lem1 : Graph.axioms (gz_graph a s)).
app gz_graph_axioms. 
ap iff_eq; ir. 
ufi gz_rel H0. 
Ztac. 
uf gz_rel. Ztac. 
rw inc_coarse. 
nin H0. 
nin H0. ee. sh (forward_edge (id a x)).
sh (freecat_id x). 
ee. app mor_forward_edge. app mor_id. 
rw mor_gz_freecat. ap mor_freecat_id. 
rw inc_vertices_gz_graph. am. am. 
am. am. 
rw source_forward_edge. rw source_freecat_id. 
rw source_id. tv. am. 
rw target_forward_edge. rw target_id. 
rww target_freecat_id. am. am. 

nin H0. nin H0. ee. 
assert (mor a x). 
uh H; ee. au. 
sh (freecat_comp (forward_edge x) (backward_edge x)).
sh (freecat_id (target x)). 
ee. 
rw mor_gz_freecat. 
ap mor_freecat_comp. 
wr mor_gz_freecat. ap  mor_forward_edge. am. am. 
am. wr mor_gz_freecat. ap  mor_backward_edge. am. am. 
am. 
rw source_forward_edge. rww target_backward_edge. 
am. 
rw mor_gz_freecat. 
app mor_freecat_id. 
rw inc_vertices_gz_graph. rww ob_target. 
am. am. 
rw source_freecat_comp. rw source_backward_edge. 
rw source_freecat_id. tv. 
rw target_freecat_comp. rw target_forward_edge. 
rw target_freecat_id. tv. am. 

nin H0. nin H0. ee. 
assert (mor a x). 
uh H; ee; au. 
sh (freecat_comp (backward_edge x) (forward_edge x)).
sh (freecat_id (source x)). 
ee. 
rw mor_gz_freecat. 
ap mor_freecat_comp. 
wr mor_gz_freecat. ap  mor_backward_edge. am. am. 
am. wr mor_gz_freecat. ap  mor_forward_edge. am. am. 
am. 
rw source_backward_edge. rww target_forward_edge. 
am. 
rw mor_gz_freecat. 
app mor_freecat_id. 
rw inc_vertices_gz_graph. rww ob_source. 
am. am. 
rw source_freecat_comp. rw source_forward_edge. 
rw source_freecat_id. tv. 
rw target_freecat_comp. rw target_backward_edge. 
rw target_freecat_id. tv. am. 

nin H0. nin H0. ee. 
sh (freecat_comp (forward_edge x) (forward_edge x0)).
sh (forward_edge (comp a x x0)). 
ee. 
rw mor_gz_freecat. 
ap mor_freecat_comp. 
wr mor_gz_freecat. ap  mor_forward_edge. am. am. 
am. wr mor_gz_freecat. ap  mor_forward_edge. am. am. 
am. rw source_forward_edge. rw target_forward_edge.
am. am. 
ap mor_forward_edge. am. 
rww mor_comp. 
rw source_freecat_comp. 
rw source_forward_edge. rw source_forward_edge. 
rww source_comp. 
rw target_freecat_comp. rw target_forward_edge.
rw target_forward_edge. rww target_comp. 
am. 

app gz_freecat_axioms. 
Qed.

Lemma related_gz_rel : forall a s e f,
localizing_system a s ->
related (gz_rel a s) e f =
((exists x, (ob a x & 
e = (forward_edge (id a x)) & f = (freecat_id x))) \/
(exists q, (inc q s & e =
(freecat_comp (forward_edge q) (backward_edge q)) 
& f = (freecat_id (target q)))) \/
(exists q, (inc q s & e = 
(freecat_comp (backward_edge q) (forward_edge q)) 
& f = (freecat_id (source q)))) \/
(exists u, exists v, (mor a u & mor a v & source u = target v &
e = (freecat_comp (forward_edge u) (forward_edge v))
& f = (forward_edge (comp a u v))))).
Proof.
ir. 
ap iff_eq; ir. 
uh H0. 
rwi  inc_gz_rel H0. 
nin H0; [ap or_introl | ap or_intror]. 
nin H0. sh x; ee. 
am. transitivity (pr1 (pair e f)). rww pr1_pair.
rw H1. rww pr1_pair. 
transitivity (pr2 (pair e f)). rww pr2_pair.
rw H1. rww pr2_pair. 

nin H0; [ap or_introl | ap or_intror]. 
nin H0. ee. sh x; ee. am. 
transitivity (pr1 (pair e f)). rww pr1_pair.
rw H1. rww pr1_pair. 
transitivity (pr2 (pair e f)). rww pr2_pair.
rw H1. rww pr2_pair. 

nin H0; [ap or_introl | ap or_intror]. 
nin H0. sh x; ee. am. 
transitivity (pr1 (pair e f)). rww pr1_pair.
rw H1. rww pr1_pair. 
transitivity (pr2 (pair e f)). rww pr2_pair.
rw H1. rww pr2_pair. 

nin H0. nin H0. sh x. sh x0. ee.
am. am. am. 
transitivity (pr1 (pair e f)). rww pr1_pair.
rw H3. rww pr1_pair. 
transitivity (pr2 (pair e f)). rww pr2_pair.
rw H3. rww pr2_pair. 
am. 

uhg. 
rw inc_gz_rel. 

nin H0; [ap or_introl | ap or_intror]. 
nin H0. ee. sh x. ee. am. rw H1; rww H2. 

nin H0; [ap or_introl | ap or_intror]. 
nin H0. ee. sh x. ee. am. rw H1; rww H2. 

nin H0; [ap or_introl | ap or_intror]. 
nin H0. ee. sh x. ee. am. rw H1; rww H2. 

nin H0. nin H0. sh x. sh x0. ee. 
am. am. am. rw H3; rww H4. am. 
Qed.

Lemma sub_gz_rel_coarse : forall a s, 
sub (gz_rel a s) (coarse (gz_freecat a s)).
Proof.
ir. uf gz_rel. ap Z_sub. 
Qed. 

Lemma cat_rel_gz_rel : forall a s, 
localizing_system a s ->
cat_rel (gz_freecat a s) (gz_rel a s).
Proof.
ir. ap cat_rel_subset.
sh (coarse (gz_freecat a s)).
ee. ap cat_rel_coarse. 
app gz_freecat_axioms. 
ap sub_gz_rel_coarse. 
Qed.

Definition gz_cer a s := cer (gz_freecat a s) (gz_rel a s).

Lemma cat_equiv_rel_gz_cer : forall a s, 
localizing_system a s ->
cat_equiv_rel (gz_freecat a s) (gz_cer a s).
Proof.
ir. uf gz_cer. 
ap cat_equiv_rel_cer. ap cat_rel_gz_rel. 
am. 
Qed.

Lemma related_gz_cer_first_mor : forall a s e f,
localizing_system a s ->
related (gz_cer a s) e f -> mor (gz_freecat a s) e.
Proof.
ir. cp (cat_equiv_rel_gz_cer H). 
uh H1; ee. uh H1. ee. 
apply H6 with f. am. 
Qed.

Lemma related_gz_cer_second_mor : forall a s e f,
localizing_system a s ->
related (gz_cer a s) e f -> mor (gz_freecat a s) f.
Proof.
ir. cp (cat_equiv_rel_gz_cer H). 
uh H1; ee. uh H1. ee. 
apply H7 with e. am. 
Qed.

Lemma related_gz_cer_same_source : forall a s e f,
localizing_system a s ->
related (gz_cer a s) e f -> source e = source f.
Proof.
ir. cp (cat_equiv_rel_gz_cer H). 
uh H1; ee. uh H1. ee. 
au. 
Qed.

Lemma related_gz_cer_same_target : forall a s e f,
localizing_system a s ->
related (gz_cer a s) e f -> target e = target f.
Proof.
ir. cp (cat_equiv_rel_gz_cer H). 
uh H1; ee. uh H1. ee. 
au. 
Qed.

Lemma related_cer : forall a r u v,
cat_rel a r -> related r u v -> related (cer a r) u v.
Proof.
ir. cp (cer_contains H). uhg. ap H1. am. 
Qed. 

Lemma related_gz_cer_forward_edge_id : 
forall a s x,
localizing_system a s ->
ob a x -> related (gz_cer a s) (forward_edge (id a x)) (freecat_id x).
Proof.
ir. 
uf gz_cer. 
ap related_cer. app cat_rel_gz_rel. 
rw related_gz_rel. 
ap or_introl. sh x. ee. am. tv. tv. am. 
Qed.

Lemma related_gz_cer_comp_forward_backward : forall a s q,
localizing_system a s -> inc q s ->
related (gz_cer a s) (freecat_comp (forward_edge q) (backward_edge q)) 
(freecat_id (target q)).
Proof.
ir. 
uf gz_cer. 
ap related_cer. app cat_rel_gz_rel. 
rw related_gz_rel. 
ap or_intror. ap or_introl. 
sh q. ee. am. tv. tv. am. 
Qed.

Lemma related_gz_cer_comp_backward_forward : forall a s q,
localizing_system a s -> inc q s ->
related (gz_cer a s) (freecat_comp (backward_edge q) (forward_edge q)) 
(freecat_id (source q)).
Proof.
ir. 
uf gz_cer. 
ap related_cer. app cat_rel_gz_rel. 
rw related_gz_rel. 
ap or_intror; ap or_intror; ap or_introl.
sh q; ee; try am; try tv. am. 
Qed.


Lemma related_gz_cer_comp_forward : forall a s u v,
localizing_system a s -> mor a u -> mor a v -> 
source u = target v ->
related (gz_cer a s) (freecat_comp (forward_edge u) (forward_edge v))
(forward_edge (comp a u v)).
Proof.
ir. 
uf gz_cer. 
ap related_cer. app cat_rel_gz_rel. 
rw related_gz_rel. 
ap or_intror; ap or_intror; ap or_intror.
sh u. sh v. ee; try am; try tv. am. 
Qed. 



Lemma compatible_gz_cer_criterion : forall a s f,
localizing_system a s -> 
Functor.axioms f ->
source f = gz_freecat a s ->
(forall x, ob a x -> fmor f (forward_edge (id a x)) = id (target f) (fob f x)) ->
(forall q, inc q s ->
are_inverse (target f) (fmor f (forward_edge q)) (fmor f (backward_edge q))) ->
(forall u v, mor a u -> mor a v -> source u = target v ->
comp (target f) (fmor f (forward_edge u)) (fmor f (forward_edge v)) =
fmor f (forward_edge (comp a u v))) ->
compatible (gz_cer a s) f.
Proof.
ir. 
uf gz_cer. ap compatible_cer. 

rw compatible_rw. 
ee. am. 
rw H1. app cat_rel_gz_rel. 

ir. 
rwi related_gz_rel H5. 
nin H5. 
nin H5. ee. rw H6. 
assert (y = id (freecat (gz_graph a s)) x0).
rw id_freecat. am. app gz_graph_axioms. 
change (ob (gz_freecat a s) x0). rww ob_gz_freecat. 
rw H2. rw H8. 
rw fmor_id. tv. am. 
am. change (ob (gz_freecat a s) x0). rww ob_gz_freecat. 
am. 

nin H5. nin H5. ee. 
rw H6. 
assert (y = id (freecat (gz_graph a s)) (target x0)).
rw id_freecat. am. app gz_graph_axioms. 
change (ob (gz_freecat a s) (target x0)). rww ob_gz_freecat. 
rww ob_target. uh H; ee; au. 
rw H8. 
rw fmor_id. 


assert (freecat_comp (forward_edge x0) (backward_edge x0)
= comp (source f) (forward_edge x0) (backward_edge x0)).
rw H1. rw comp_gz_freecat. reflexivity. am. 
ap mor_forward_edge. am. uh H; ee; au. 
ap mor_backward_edge. am. am. 
rw source_forward_edge. rww target_backward_edge. 
rw H9. rw fmor_comp. 

cp (H3 _ H5). 
uh H10. ee. rw H14. 
rw source_fmor. rw source_backward_edge. 
reflexivity. 
am. 
rw H1. ap mor_backward_edge. am. am. 
am. tv. rw H1. ap mor_forward_edge. 
am. uh H; ee; au. 
rw H1. app mor_backward_edge. 
rw source_forward_edge. rww target_backward_edge. 
am. am. 
change (ob (gz_freecat a s) (target x0)). 
rw ob_gz_freecat. rw ob_target. tv. 
uh H; ee; au. am. 



nin H5. nin H5. ee. 
rw H6. 
assert (y = id (freecat (gz_graph a s)) (source x0)).
rw id_freecat. am. app gz_graph_axioms. 
change (ob (gz_freecat a s) (source x0)). rww ob_gz_freecat. 
rww ob_source. uh H; ee; au. 
rw H8. 
rw fmor_id. 


assert (freecat_comp (backward_edge x0) (forward_edge x0)
= comp (source f) (backward_edge x0) (forward_edge x0)).
rw H1. rw comp_gz_freecat. reflexivity. am. 
ap mor_backward_edge. am. am. 
ap mor_forward_edge. am. uh H; ee; au.  
rw source_backward_edge. rww target_forward_edge. 
rw H9. rw fmor_comp. 

cp (H3 _ H5). 
uh H10. ee. rw H15. 
rw source_fmor. rw source_forward_edge. 
reflexivity. 
am. 
rw H1. ap mor_forward_edge. am. uh H; ee; au.  
am. tv. rw H1. ap mor_backward_edge. 
am. am. 
rw H1. app mor_forward_edge. uh H; ee; au. 
rw source_backward_edge. rww target_forward_edge. 
am. am. 
change (ob (gz_freecat a s) (source x0)). 
rw ob_gz_freecat. rw ob_source. tv. 
uh H; ee; au. am. 



nin H5. nin H5. ee. rw H8. 
rw H9. 
assert (freecat_comp (forward_edge x0) (forward_edge x1) 
= comp (source f) (forward_edge x0) (forward_edge x1)).
rw H1. rw comp_gz_freecat. reflexivity. 
am. 
app mor_forward_edge. 
app mor_forward_edge. 
rw source_forward_edge. 
rw target_forward_edge. am. 
rw H10. 
wr comp_fmor. ap H4. am. am. am. 
am. rw H1. app mor_forward_edge. 
rw H1. app mor_forward_edge. 
rw source_forward_edge. 
rw target_forward_edge. am. 
am. sy; am. 
Qed.




Definition gz_loc a s :=
quotient_cat (gz_freecat a s) (gz_cer a s).

Lemma gz_loc_axioms : forall a s,
localizing_system a s -> 
Category.axioms (gz_loc a s).
Proof.
ir. 
uf gz_loc. 
ap quotient_cat_axioms. 
ap cat_equiv_rel_gz_cer. am. 
Qed. 

Definition gz_qprojection a s :=
qprojection (gz_freecat a s) (gz_cer a s).

Lemma source_gz_qprojection : forall a s, 
localizing_system a s -> 
source (gz_qprojection a s) = gz_freecat a s.
Proof.
ir. 
uf gz_qprojection. 
rw source_qprojection. tv. 
Qed.

Lemma target_gz_qprojection : forall a s, 
localizing_system a s -> 
target (gz_qprojection a s) = gz_loc a s.
Proof.
ir. 
uf gz_qprojection. 
rw target_qprojection. tv. 
Qed.

Lemma gz_qprojection_axioms : forall a s,
localizing_system a s -> 
Functor.axioms (gz_qprojection a s).
Proof.
ir. 
uf gz_qprojection. 
ap qprojection_axioms. 
app cat_equiv_rel_gz_cer.
Qed.



Definition gz_proj a s :=
qfunctor a (gz_freecat a s) (gz_cer a s) 
(fun x => x) forward_edge.

Lemma source_gz_proj : forall a s,
localizing_system a s -> 
source (gz_proj a s) = a.
Proof.
ir. uf gz_proj. 
rw source_qfunctor. tv. 
Qed.

Lemma target_gz_proj : forall a s,
localizing_system a s -> 
target (gz_proj a s) = gz_loc a s.
Proof.
ir. uf gz_proj. 
rw target_qfunctor. tv. 
Qed.

Definition gz_forward a s u :=
arrow_class (gz_cer a s) (forward_edge u).

Definition gz_backward a s u :=
arrow_class (gz_cer a s) (backward_edge u).

Lemma source_gz_forward : forall a s u,
localizing_system a s -> 
mor a u -> source (gz_forward a s u) = source u.
Proof.
ir. 
uf gz_forward. 
rw source_arrow_class. rw source_forward_edge.
tv. 
Qed.

Lemma target_gz_forward : forall a s u,
localizing_system a s -> 
mor a u -> target (gz_forward a s u) = target u.
Proof.
ir. 
uf gz_forward. 
rw target_arrow_class. rw target_forward_edge.
tv. 
Qed.

Lemma source_gz_backward : forall a s q,
localizing_system a s -> 
inc q s -> source (gz_backward a s q) = target q.
Proof.
ir. 
uf gz_backward. 
rw source_arrow_class. rw source_backward_edge.
tv. 
Qed.

Lemma target_gz_backward : forall a s q,
localizing_system a s -> 
inc q s -> target (gz_backward a s q) = source q.
Proof.
ir. 
uf gz_backward. 
rw target_arrow_class. rw target_backward_edge.
tv. 
Qed.

Lemma mor_gz_forward :  forall a s u,
localizing_system a s -> 
mor a u -> mor (gz_loc a s) (gz_forward a s u).
Proof.
ir. uf gz_forward. 
uf gz_loc. ap  mor_quotient_cat_arrow_class. 
app cat_equiv_rel_gz_cer. 
app mor_forward_edge. 
Qed.

Lemma mor_gz_backward :  forall a s q,
localizing_system a s -> 
inc q s -> mor (gz_loc a s) (gz_backward a s q).
Proof.
ir. uf gz_backward. 
uf gz_loc. ap  mor_quotient_cat_arrow_class. 
app cat_equiv_rel_gz_cer. 
app mor_backward_edge. 
Qed.

Lemma qfunctor_property_forward_edge : 
forall a s, localizing_system a s -> 
qfunctor_property a (gz_freecat a s) (gz_cer a s) 
(fun x => x) forward_edge.
Proof.
ir. 
uhg; ee. uh H; ee; am. 
app cat_equiv_rel_gz_cer. 

ir. rww ob_gz_freecat. 

ir. app mor_forward_edge. 

ir. rww source_forward_edge. 

ir. rww target_forward_edge. 

ir. rw id_gz_freecat. 
ap related_gz_cer_forward_edge_id. am. 
am. am. am. 

ir. 
rw comp_gz_freecat. 
ap symmetric_ap. 
cp (cat_equiv_rel_gz_cer H). uh H3.
ee. uh H4. ee. am. 
ap related_gz_cer_comp_forward. 
am. am. am. am. am. 
app mor_forward_edge. 
app mor_forward_edge. 
rw source_forward_edge. 
rww target_forward_edge. 
Qed. 

Lemma gz_proj_axioms : forall a s,
localizing_system a s -> 
Functor.axioms (gz_proj a s). 
Proof.
ir. 
uf gz_proj. 
ap qfunctor_axioms. 
ap qfunctor_property_forward_edge.
am. 
Qed.

Lemma fob_gz_proj : forall a s x,
localizing_system a s -> 
ob a x -> 
fob (gz_proj a s) x = x.
Proof.
ir. uf gz_proj. 
rw fob_qfunctor. tv.
app qfunctor_property_forward_edge.
am. 
Qed. 


Lemma fmor_gz_proj : forall a s u,
localizing_system a s -> 
mor a u -> fmor (gz_proj a s) u = 
gz_forward a s u.
Proof.
ir. uf gz_proj. 
rw fmor_qfunctor. tv.
am. 
Qed.

Lemma gz_forward_id : forall a s x,
localizing_system a s -> 
ob a x -> gz_forward a s (id a x) = id (gz_loc a s) x.
Proof.
ir. 
wr fmor_gz_proj. 
rw fmor_id. 
rw target_gz_proj. 
rw fob_gz_proj. tv. am. am. 
am. ap gz_proj_axioms. am. 
rww source_gz_proj. 
am. am. app mor_id. 
Qed.

Lemma comp_gz_forward : forall a s u v,
localizing_system a s -> mor a u -> mor a v ->
source u = target v -> 
comp (gz_loc a s) (gz_forward a s u) (gz_forward a s v) =
gz_forward a s (comp a u v).
Proof.
ir. wrr fmor_gz_proj. 
wrr fmor_gz_proj. 
assert (gz_loc a s = target (gz_proj a s)). 
rww target_gz_proj. rw H3. 
rw comp_fmor. rw source_gz_proj. 
rww fmor_gz_proj. rww mor_comp. am. 
app gz_proj_axioms. rw source_gz_proj. 
am. am. rww source_gz_proj. am. 
Qed.



Lemma are_inverse_gz_forward_backward : forall a s q,
localizing_system a s -> 
inc q s -> are_inverse (gz_loc a s) (gz_forward a s q)
(gz_backward a s q).
Proof.
ir. 
assert (mor a q). 
uh H; ee; au. 
uhg; ee. 

app mor_gz_forward. 
app mor_gz_backward. 
rww source_gz_forward. rww target_gz_backward.
rww source_gz_backward. rww target_gz_forward. 

rww source_gz_backward.
assert (mor (gz_freecat a s) (forward_edge q)).
app mor_forward_edge. 
assert (mor (gz_freecat a s) (backward_edge q)).
app mor_backward_edge. 
assert (source (forward_edge q) = target (backward_edge q)).
rww source_forward_edge. rww target_backward_edge. 
assert (cat_equiv_rel (gz_freecat a s) (gz_cer a s)).
app cat_equiv_rel_gz_cer. 

uf gz_loc. 
uf gz_forward. 
uf gz_backward. 
rw comp_quotient_cat. 
rw quot_comp_arrow_class. 
rw id_quotient_cat. 
uf quot_id. 
rewrite <- related_arrow_class_eq with (a:=gz_freecat a s). 
rw comp_gz_freecat. 
rw id_gz_freecat. 
ap related_gz_cer_comp_forward_backward. am. 
am. am. rww ob_target. am. am.
am. am. am. rw mor_comp. 
tv. am. am. am. 
tv.
am. rww ob_gz_freecat. rww ob_target. 
am. am. am. am. am. ap is_quotient_arrow_arrow_class. 
am. am. ap is_quotient_arrow_arrow_class. am. am. 
rw source_arrow_class. 
rw target_arrow_class. am. 


rww source_gz_forward.
assert (mor (gz_freecat a s) (forward_edge q)).
app mor_forward_edge. 
assert (mor (gz_freecat a s) (backward_edge q)).
app mor_backward_edge. 
assert (source (backward_edge q) = target (forward_edge q)).
rww target_forward_edge. rww source_backward_edge. 
assert (cat_equiv_rel (gz_freecat a s) (gz_cer a s)).
app cat_equiv_rel_gz_cer. 

uf gz_loc. 
uf gz_forward. 
uf gz_backward. 
rw comp_quotient_cat. 
rw quot_comp_arrow_class. 
rw id_quotient_cat. 
uf quot_id. 
rewrite <- related_arrow_class_eq with (a:=gz_freecat a s). 
rw comp_gz_freecat. 
rw id_gz_freecat. 
ap related_gz_cer_comp_backward_forward. am. 
am. am. rww ob_source. am. am.
am. am. am. rw mor_comp. 
tv. am. am. am. 
tv.
am. rww ob_gz_freecat. rww ob_source. 
am. am. am. am. am. ap is_quotient_arrow_arrow_class. 
am. am. ap is_quotient_arrow_arrow_class. am. am. 
rw source_arrow_class. 
rw target_arrow_class. am. 
Qed.

Lemma invertible_gz_loc_gz_forward : forall a s q,
localizing_system a s -> inc q s -> 
invertible (gz_loc a s) (gz_forward a s q).
Proof.
ir. 
uhg. sh (gz_backward a s q). 
ap are_inverse_gz_forward_backward. am. am. 
Qed. 



End GZ_Def. 


Module GZ_Thm.
Export Ob_Iso_Functor.
Export GZ_Def.


(** The first step in showing the universal property of [gz_proj]
and Theorem 1.2, is to apply the general results of [Ob_Iso_Functor]
to show that [pull_functor (gz_proj a s) b] is an isomorphism onto a 
full subcategory. We have to show that 
[add_inverses (gz_loc a s) (mor_image (gz_proj a s))] generates
[gz_loc a s], basically because of the induction statement 
[mor_freecat_induction]
saying that [gz_freecat (gz_graph a s)] 
is generated by the edges of the graph. **)


Lemma inc_gz_forward_mor_image : forall a s u,
localizing_system a s -> 
mor a u -> inc (gz_forward a s u) (mor_image (gz_proj a s)).
Proof.
ir. 
rw inc_mor_image. 
sh u. ee. 
rw source_gz_proj. am. am. 
rw fmor_gz_proj. tv. am. am. 
app gz_proj_axioms. 
Qed.

Lemma inc_gz_backward_add_inverses : 
forall a s q,
localizing_system a s -> 
inc q s -> inc (gz_backward a s q) (add_inverses (gz_loc a s) (mor_image (gz_proj a s))).
Proof.
ir. 
rw inc_add_inverses. 
ee. ap mor_gz_backward. 
am. am. 
ap or_intror. 
ee. 
uhg. 
sh (gz_forward a s q). 
ap are_inverse_symm. 
ap are_inverse_gz_forward_backward. am. 
am. 
assert (inverse (gz_loc a s) (gz_backward a s q)
= gz_forward a s q). 
ap inverse_eq. 

ap are_inverse_symm. 
app are_inverse_gz_forward_backward.
rw H1. 
app inc_gz_forward_mor_image. uh H; ee; au. 

app gz_loc_axioms. 
uhg; ir. 
rwi inc_mor_image H1. 
nin H1. ee. 
ap mor_is_mor. wr H2. 
assert (gz_loc a s = target (gz_proj a s)). 
rw target_gz_proj. tv. am. 
rw H3. app mor_fmor. 
app gz_proj_axioms. 
app gz_proj_axioms. 
Qed.

Lemma gz_loc_induction : forall a s (P:E->Prop),
localizing_system a s ->
(forall u, mor a u -> P (gz_forward a s u)) ->
(forall q, inc q s -> P (gz_backward a s q)) ->
(forall x, ob a x -> P (id (gz_loc a s) x)) ->
(forall u v, mor (gz_loc a s) u -> 
mor (gz_loc a s) v -> source u = target v ->
P u -> P v -> P (comp (gz_loc a s) u v)) ->
(forall y, mor (gz_loc a s) y -> P y).
Proof.
ir. 
assert (lem1 : cat_equiv_rel (gz_freecat a s) (gz_cer a s)).
app cat_equiv_rel_gz_cer. 
set (Q:= fun z => P (arrow_class (gz_cer a s) z)).
ufi gz_loc H4. 
rwi mor_quotient_cat H4. 
uh H4; ee. 
nin H5. 
ee. rw H6. 
change (Q x). 
apply mor_freecat_induction with
(g:=gz_graph a s) (P:=Q).
app gz_graph_axioms. 
ir. 
rwi inc_vertices_gz_graph H7. 
assert (P (id (gz_loc a s) x0)).
ap H2. am. 
ufi gz_loc H8. 
rwi id_quotient_cat H8. 
uf Q. 
ufi quot_id H8. 
rwi id_gz_freecat H8. am. am. 
am. am. rww ob_gz_freecat. am. 

ir. rwi inc_edges_gz_graph H7. 
rwi inc_loc_edges H7. 



assert (Q (freecat_edge u)).
nin H7. 
nin H7. ee. 
uf Q.  rw H11. 
exact (H0 _ H7). 

nin H7. ee. rw H12. 
exact (H1 _ H11). 

uf chain_tack. 

assert (P (comp (gz_loc a s) 
(arrow_class (gz_cer a s) (freecat_edge u))
(arrow_class (gz_cer a s) v))).
ap H3. 
uf gz_loc. ap mor_quotient_cat_arrow_class. 
am. uf gz_freecat. 
rw mor_freecat_rw. ap mor_freecat_edge. 
app gz_graph_axioms. rw inc_edges_gz_graph. 
rw inc_loc_edges. 
am. am. am. 
app gz_graph_axioms. 
uf gz_loc. 
ap mor_quotient_cat_arrow_class. am. 
rw mor_gz_freecat. am. am. 
rw source_arrow_class. 
rw source_freecat_edge. 
rw target_arrow_class. am. 

nin H7. nin H7; ee. rw H12. 
exact (H0 _ H7).
nin H7; ee. rw H13. exact (H1 _ H12). 
exact H10. 
uf Q. 
ufi gz_loc H12. 
rwi comp_quotient_cat H12. 
rwi quot_comp_arrow_class H12. 
rwi comp_gz_freecat H12. 

am. 

am. 
rw  mor_gz_freecat. ap mor_freecat_edge.
app gz_graph_axioms. 
rw inc_edges_gz_graph. 
rw inc_loc_edges. am. 
am. am. am. rww  mor_gz_freecat. 
rww source_freecat_edge. 
am. 
rw  mor_gz_freecat. ap mor_freecat_edge.
app gz_graph_axioms. 
rw inc_edges_gz_graph. 
rw inc_loc_edges. am. 
am. am. am. 
rww  mor_gz_freecat. 
rww source_freecat_edge. 
am. 

ap is_quotient_arrow_arrow_class. am. 
rw  mor_gz_freecat. ap mor_freecat_edge.
app gz_graph_axioms. 
rw inc_edges_gz_graph. 
rw inc_loc_edges. am. 
am. am. am. 
ap is_quotient_arrow_arrow_class. am. 
rww  mor_gz_freecat. 
rw source_arrow_class. 
rw source_freecat_edge. 
rw target_arrow_class. am. 
am. am. rwi mor_gz_freecat H5. am. am. 
am. 
Qed.



Lemma gz_loc_subcategory_all_criterion : forall a s b,
localizing_system a s -> is_subcategory b (gz_loc a s) ->
(forall u, mor a u -> mor b (gz_forward a s u)) ->
(forall q, inc q s -> mor b (gz_backward a s q)) ->
b = gz_loc a s.
Proof.
ir. 
assert (forall x, ob a x -> ob b x).
ir. 
assert (mor b (gz_forward a s (id a x))).
ap H1. app mor_id. 
assert (x = source (gz_forward a s (id a x))).
rw source_gz_forward. rw source_id. tv. am. 
am. app mor_id. 
rw H5. 
rw ob_source. tv. ap H1. 
app mor_id. 
ap subcategory_all_criterion. am. 
ir. 
apply gz_loc_induction with (a:=a)(s:=s)(P:=mor b).
am. 
ir. ap H1. am. 
ir. ap H2. am. 
ir. 
assert (ob b x). app H3. 
assert (id b x = id (gz_loc a s) x).
app is_subcategory_same_id. 
assert (mor b (gz_forward a s (id a x))).
ap H1. app mor_id. 
wr H7. app mor_id. 

ir. assert (comp b u0 v = comp (gz_loc a s) u0 v).
ap is_subcategory_same_comp. am. am. 
am. am. wr H10. rww mor_comp. am. 
Qed.

Lemma add_inverses_mor_image_gz_proj_generates_gz_loc : forall a s,
localizing_system a s -> 
generates (gz_loc a s) (add_inverses (gz_loc a s) (mor_image (gz_proj a s))).
Proof.
ir. 
uhg; ee. app gz_loc_axioms. 
uhg; ir. rwi inc_add_inverses H0.
ee. app mor_is_mor. app gz_loc_axioms.
uhg; ir. rwi inc_mor_image H1. 
nin H1. ee. ap mor_is_mor. wr H2. 
assert (gz_loc a s = target (gz_proj a s)). 
rww target_gz_proj. rw H3. 
app mor_fmor. app gz_proj_axioms. 
app gz_proj_axioms. 

ir. 
ap gz_loc_subcategory_all_criterion. 
am. am. 
ir. uh H1. ap is_mor_mor. uh H0; ee; am. 
uhg. ap H1. 
rw inc_add_inverses. ee. 
ap mor_gz_forward. am. am. 
ap or_introl. app inc_gz_forward_mor_image.
app gz_loc_axioms. 
uhg; ir. ap mor_is_mor. 
rwi inc_mor_image H3. nin H3. ee. 
wr H4. 
rw fmor_gz_proj. app mor_gz_forward. rwi source_gz_proj H3. 
am. am. am. rwi source_gz_proj H3. 
am. am. app gz_proj_axioms. 

ir. ap is_mor_mor. 
uh H0; ee; am. uhg. uh H1. ap H1. 
app inc_gz_backward_add_inverses. 
Qed.

Lemma ob_gz_loc : forall a s x,
localizing_system a s ->
ob (gz_loc a s) x = ob a x.
Proof.
ir. uf gz_loc. rw ob_quotient_cat.
rw ob_gz_freecat. tv. am. 
app cat_equiv_rel_gz_cer. 
Qed. 

Lemma ob_iso_gz_proj : forall a s,
localizing_system a s -> ob_iso (gz_proj a s).
Proof.
ir. 
uhg; ee. uhg; ee. 
app gz_proj_axioms. ir. 
rwi source_gz_proj H0. 
rwi source_gz_proj H1. 
rwi fob_gz_proj H2.
rwi fob_gz_proj H2.
am. am. am. am. am. am. am. 

uhg; ee. 
app gz_proj_axioms. ir. 
rwi target_gz_proj H0. 
rwi ob_gz_loc H0. 
uhg; ee. 
ap gz_proj_axioms. am. 
sh x. ee. rww source_gz_proj. 
rww fob_gz_proj. am. am. 
Qed. 

(** The following corollary says that the 
functor of pullback (or composition) along
the projection [gz_proj a s] induces an isomorphism 
of [functor_catgory (gz_loc a s) b] to a subcategory of 
[functor_category a b]. Note Lemma 
[iso_to_full_subcategory_interp] (in [qcat.v])
for a different interpretation
of the definition [iso_to_full_subcategory],
close to the meaning of the phrase ``induces an isomorphism
onto the full subcategory...''. **)

Lemma iso_to_subcategory_pull_gz_proj : forall a s b,
localizing_system a s -> Category.axioms b ->
iso_to_full_subcategory (pull_morphism b (gz_proj a s)).
Proof.
ir. 
ap iso_to_full_subcategory_pull_morphism_criterion.
am. 
app ob_iso_gz_proj. 
rw target_gz_proj. 
app add_inverses_mor_image_gz_proj_generates_gz_loc. 
am. 
Qed.


(** As a corollary we obtain the uniqueness part of the universal property of [gz_proj]. **)

Lemma gz_proj_epimorphic : forall a s f g,
localizing_system a s -> Functor.axioms f ->
Functor.axioms g -> source f = gz_loc a s ->
source g = gz_loc a s ->
fcompose f (gz_proj a s) = fcompose g (gz_proj a s) ->
f = g.
Proof.
ir. 
assert (Category.axioms (target f)).
uh H0; ee; am. 
assert (target f = target g).
transitivity (target (fcompose f (gz_proj a s))).
rww target_fcompose. rw H4. 
rww target_fcompose. 
cp (iso_to_subcategory_pull_gz_proj H H5).
uh H7; ee. 
uh H9; ee. ap H10. 
rw source_pull_morphism. 
rw target_gz_proj. rw ob_functor_cat. uhg; ee.
am. am. tv. app gz_loc_axioms. 
uh H0; ee; am. am. 
rw source_pull_morphism. 
rw target_gz_proj. 
rw ob_functor_cat. uhg; ee. 
am. am. sy; am. 
app gz_loc_axioms. am. 
am. 
rw fob_pull_morphism. 
rw fob_pull_morphism. 
am. 
app gz_proj_axioms. am. 
rw target_gz_proj. 
rw ob_functor_cat. 
uhg; ee. am. 
am. sy; am. 
app gz_loc_axioms. am. am. 
app gz_proj_axioms. am. 
rw target_gz_proj. 
rw ob_functor_cat. uhg; ee. 
am. am. tv.  
app gz_loc_axioms. am. 
am. 
Qed.




(** We now show the essential part of GZ's Theorem 1.2, which is the versal part of the
universal property of [gz_proj], which we mainly express by constructing the 
functor [gz_dotted]. **)

Definition loc_compatible a s f :=
localizing_system a s &
Functor.axioms f &
source f = a &
(forall q, inc q s -> invertible (target f) (fmor f q)).

Definition fr_dotted a s f :=
free_functor (gz_graph a s) (target f)
(fun x => fob f x)
(fun u => Y (direction u = Forward) (fmor f (original_arrow u))
(inverse (target f) (fmor f (original_arrow u)))).

Lemma backward_neq_forward : Backward <> Forward.
Proof.
uhg; ir. ufi Backward H. 
ufi Forward H. cp (R_inj H). discriminate H0. 
Qed. 


Lemma Y_etc_forward_arrow : forall f u,
Y (direction (forward_arrow u) = Forward) (fmor f (original_arrow (forward_arrow u)))
(inverse (target f) 
(fmor f (original_arrow (forward_arrow u)))) = fmor f u.
Proof.
ir. 
rw Y_if_rw. 
rw original_arrow_forward_arrow. 
tv.  rww direction_forward_arrow. 
Qed.

Lemma Y_etc_backward_arrow : forall f q,
Y (direction (backward_arrow q) = Forward) 
(fmor f (original_arrow (backward_arrow q)))
(inverse (target f) 
(fmor f (original_arrow (backward_arrow q)))) = 
inverse (target f) (fmor f q).
Proof.
ir. 
rw Y_if_not_rw.  rw original_arrow_backward_arrow. 
tv. rw direction_backward_arrow.
ap backward_neq_forward. 
Qed.


Lemma fr_dotted_property : forall a s f,
loc_compatible a s f -> free_functor_property
(gz_graph a s) (target f)
(fun x => fob f x)
(fun u => Y (direction u = Forward) (fmor f (original_arrow u))
(inverse (target f) (fmor f (original_arrow u)))). 
Proof.
ir. uh H; 
uhg; ee. 
app gz_graph_axioms. 
uh H0; ee; am. 
ir. rwi inc_vertices_gz_graph H3. 
ap ob_fob. am. rww H1. am. 

ir. rwi inc_edges_gz_graph H3.
rwi inc_loc_edges H3. 
nin H3. nin H3. 
ee. 
rw H4. rw Y_etc_forward_arrow. 
wri H1 H3. app mor_fmor. 
nin H3. ee. rw H5. 
rw Y_etc_backward_arrow. 
ap mor_inverse. ap H2. am. am. am. 

ir. rwi inc_edges_gz_graph H3.
rwi inc_loc_edges H3. 
nin H3. nin H3. 
ee. rw H4. rw Y_etc_forward_arrow. 
rw source_forward_arrow. rww source_fmor. 
rw H1. am. 

nin H3. ee. rw H5. 
rw Y_etc_backward_arrow. 
assert (invertible (target f) (fmor f x)).
au. 
rw source_inverse. rw source_backward_arrow.
rw target_fmor. tv. am. rww H1. am. 
am. am. 

ir. rwi inc_edges_gz_graph H3.
rwi inc_loc_edges H3. 
nin H3. nin H3. 
ee. rw H4. rw Y_etc_forward_arrow. 
rw target_forward_arrow. rww target_fmor. 
rw H1. am. 

nin H3. ee. rw H5. 
rw Y_etc_backward_arrow. 
assert (invertible (target f) (fmor f x)).
au. 
rw target_inverse. rw target_backward_arrow.
rw source_fmor. tv. am. rww H1. am. 
am. am. 



Qed. 

Lemma source_fr_dotted : forall a s f,
source (fr_dotted a s f) = gz_freecat a s.
Proof.
ir. uf fr_dotted. 
rw source_free_functor. tv. 
Qed.

Lemma target_fr_dotted : forall a s f,
target (fr_dotted a s f) = target f.
Proof.
ir. uf fr_dotted. 
rw target_free_functor. tv. 
Qed.

Lemma fob_fr_dotted : forall a s f x,
loc_compatible a s f -> ob a x ->
fob (fr_dotted a s f) x = fob f x.
Proof.
ir. 
uf fr_dotted. rw fob_free_functor. tv. 
ap fr_dotted_property. am. 
rw inc_vertices_gz_graph. am. uh H; ee; am. 
Qed.

Lemma fmor_fr_dotted_forward_edge : forall a s f u,
loc_compatible a s f -> mor a u ->
fmor (fr_dotted a s f) (forward_edge u) =
fmor f u.
Proof.
ir. uf fr_dotted. uf forward_edge. 
rw fmor_ff_freecat_edge. 
rw Y_etc_forward_arrow. tv. 
ap fr_dotted_property. am. 
rw inc_edges_gz_graph. 
ap inc_forward_arrow_loc_edges. uh H; ee; am. am. 
uh H; ee; am. 
Qed.

Lemma fmor_fr_dotted_backward_edge : forall a s f q,
loc_compatible a s f -> inc q s ->
fmor (fr_dotted a s f) (backward_edge q) =
inverse (target f) (fmor f q).
Proof.
ir. uf fr_dotted. uf backward_edge. 
rw fmor_ff_freecat_edge. 
rw Y_etc_backward_arrow. tv. 
ap fr_dotted_property. am. 
rw inc_edges_gz_graph. 
ap inc_backward_arrow_loc_edges. uh H; ee; am. am. 
uh H; ee; am. 
Qed.


Lemma fr_dotted_axioms : forall a s f,
loc_compatible a s f -> 
Functor.axioms (fr_dotted a s f).
Proof.
ir. 
uf fr_dotted. 
ap free_functor_axioms. 
ap fr_dotted_property. am. 
Qed. 

Lemma compatible_gz_cer_fr_dotted : forall a s f,
loc_compatible a s f ->
compatible (gz_cer a s) (fr_dotted a s f).
Proof.
ir. 
ap compatible_gz_cer_criterion. 
uh H; ee; am. 
ap fr_dotted_axioms. 
am. rw source_fr_dotted. tv. 

ir. 
rw fmor_fr_dotted_forward_edge. 
rw target_fr_dotted. 
rw fob_fr_dotted. rw fmor_id. tv. 
uh H; ee; am. uh H; ee; am. am. am. 
am. am. app mor_id. 


ir. 
cp H. 
uh H1; ee. 
cp (H4 _ H0). 
assert (mor a q). 
uh H1; ee; au. 
rww fmor_fr_dotted_forward_edge. 
rww fmor_fr_dotted_backward_edge. 
rww target_fr_dotted. 
ap invertible_inverse. am. 

ir. 
rww fmor_fr_dotted_forward_edge. 
rww fmor_fr_dotted_forward_edge. 
rww fmor_fr_dotted_forward_edge. 
rw target_fr_dotted. rw fmor_comp. 
tv. uh H; ee; am. uh H; ee; am. am. am. 
am. rww mor_comp. 
Qed. 

Definition gz_dotted a s f :=
qdotted (gz_cer a s) (fr_dotted a s f).

Lemma source_gz_dotted : forall a s f,
source (gz_dotted a s f) = gz_loc a s.
Proof.
ir. uf gz_dotted. 
rw source_qdotted. 
rw source_fr_dotted. tv. 
Qed.

Lemma target_gz_dotted : forall a s f,
target (gz_dotted a s f) = target f.
Proof.
ir. 
uf gz_dotted. 
rw target_qdotted. rw target_fr_dotted. tv. 
Qed.

Lemma fob_gz_dotted : forall a s f x,
loc_compatible a s f -> ob a x ->
fob (gz_dotted a s f) x = fob f x.
Proof.
ir. 
uf gz_dotted. 
rw fob_qdotted. rw fob_fr_dotted. 
tv. am. am. 
rw source_fr_dotted. 
ap cat_equiv_rel_gz_cer. uh H; ee; am. 
app compatible_gz_cer_fr_dotted. 
rw source_fr_dotted. rw ob_gz_freecat. am. 
uh H; ee; am. 
Qed.

Lemma fmor_gz_dotted_gz_forward : forall a s f u,
loc_compatible a s f -> mor a u ->
fmor (gz_dotted a s f) (gz_forward a s u) = fmor f u.
Proof.
ir. 
cp H. uh H1; ee. 
uf gz_dotted. 
uf gz_forward. 
rw fmor_qdotted_arrow_class. 
rw fmor_fr_dotted_forward_edge. tv. am. 
am. 
rw source_fr_dotted. 
ap cat_equiv_rel_gz_cer.  am. 
app compatible_gz_cer_fr_dotted. 
rw source_fr_dotted. 
rw mor_gz_freecat. 
uf forward_edge. 
ap mor_freecat_edge. 
ap gz_graph_axioms. am. 
rw inc_edges_gz_graph. rw inc_loc_edges. 
ap or_introl. sh u. ee. am. tv. 
am. am. am. 
Qed.

Lemma fmor_gz_dotted_gz_backward : forall a s f q,
loc_compatible a s f -> inc q s ->
fmor (gz_dotted a s f) (gz_backward a s q) = inverse (target f) (fmor f q).
Proof.
ir. 
cp H. uh H1; ee.
assert (mor a q). 
uh H1; ee; au. 
uf gz_dotted. 
uf gz_backward. 
rw fmor_qdotted_arrow_class. 
rw fmor_fr_dotted_backward_edge. tv. am. 
am. 
rw source_fr_dotted. 
ap cat_equiv_rel_gz_cer.  am. 
app compatible_gz_cer_fr_dotted. 
rw source_fr_dotted. 
rw mor_gz_freecat. 
uf backward_edge. 
ap mor_freecat_edge. 
ap gz_graph_axioms. am. 
rw inc_edges_gz_graph. rw inc_loc_edges. 
ap or_intror. sh q. ee. am. am. tv. 
am. am. am. 
Qed.

Lemma gz_dotted_axioms : forall a s f,
loc_compatible a s f -> 
Functor.axioms (gz_dotted a s f).
Proof.
ir. 
uf gz_dotted. 
ap qdotted_axioms. 
rw source_fr_dotted. 
ap cat_equiv_rel_gz_cer. uh H; ee; am. 
ap compatible_gz_cer_fr_dotted. am. 
Qed.

(** By the following, we have successfully 
constructed the dotted functor filling in our
diagram. This shows the versality property of 
localizatin. **)

Lemma fcompose_gz_dotted_gz_proj : forall a s f, 
loc_compatible a s f -> 
fcompose (gz_dotted a s f) (gz_proj a s) = f.
Proof.
ir. 
cp H . uh H0; ee. 
ap Functor.axioms_extensionality. 
ap fcompose_axioms. ap gz_dotted_axioms. 
am. 
ap gz_proj_axioms. am. 
rw source_gz_dotted. rw target_gz_proj. 
tv. am. am. 
rw source_fcompose. rw source_gz_proj. sy; am. 
am. 
rw target_fcompose. rw target_gz_dotted. tv. 

ir. 
rwi source_fcompose H4. rwi source_gz_proj H4.

rw fmor_fcompose. 

(** An interesting point is that the following
step which is somehow essential, takes a long
time to be read by the computer. **)
rw fmor_gz_proj. 


rw fmor_gz_dotted_gz_forward. tv. 
am. am. am. am. 
app gz_dotted_axioms. 
app  gz_proj_axioms. 
rw source_gz_dotted. rw target_gz_proj.
tv. am. rw source_gz_proj. am. am. am. 
Qed.

(** We also have to show that our sufficient
condition in versality is also necessary, 
in order to get a characterization of the
functors which factor through gz_proj. **)

Lemma loc_compatible_fcompose : forall a s g,
localizing_system a s ->
Functor.axioms g ->
source g = gz_loc a s ->
loc_compatible a s (fcompose g (gz_proj a s)).
Proof.
ir. 
uhg; ee.
am. 
ap fcompose_axioms. am. 
app gz_proj_axioms. rww target_gz_proj.
rww source_fcompose. rww source_gz_proj. 

ir. 
rw target_fcompose. 
rw fmor_fcompose. 
ap invertible_fmor. am. 
rw H1. 
rw fmor_gz_proj. 

ap invertible_gz_loc_gz_forward. 
am. am. am. uh H; ee; au. 
tv. am. 
app gz_proj_axioms. 
rww target_gz_proj. 
rw source_gz_proj. uh H; ee; au. 
am. 
Qed.

(**
Definition ob_image f :=
Z (objects (target f)) (fun x => (exists y, (ob (source f) y & fob f y = x))).
**)

(** The following statement characterizes the 
essential image of [pull_functor (gz_proj a s) b]. **)

Lemma ob_image_pull_gz_proj : forall a s b f,
localizing_system a s -> 
Category.axioms b ->
inc f (ob_image (pull_morphism b (gz_proj a s))) =
(Functor.axioms f & source f = a & target f = b &
(forall q, inc q s -> invertible b (fmor f q))).
Proof.
ir. 
cp H. uh H1; ee. 
ap iff_eq; ir. 

assert (ob (functor_cat a b) f).


ufi ob_image H3. 
Ztac. 
rwi target_pull_morphism H4. 
rwi source_gz_proj H4. 
assert (ob (functor_cat a b) f). 
ap is_ob_ob. ap functor_cat_axioms. 
uh H; ee; am. am. am. am. 
am. 

assert (exists g, 
(ob (functor_cat (gz_loc a s) b) g & 
f = fcompose g (gz_proj a s))).

ufi ob_image H3. 
Ztac. 
nin H6. ee. 
rwi source_pull_morphism H6. 
rwi target_gz_proj H6. 
rwi fob_pull_morphism H7. 
sh x. ee. am. sy; am. 
app gz_proj_axioms. am. 
rw target_gz_proj. am. am. am. 

rwi ob_functor_cat H4. uh H4; ee. 
am. am. am. 

ir. nin H5. 
ee. 
assert (loc_compatible a s f).
rw H9. 
ap loc_compatible_fcompose. 
am. rwi ob_functor_cat H5. 
uh H5; ee; am. 
app gz_loc_axioms. am. 
rwi ob_functor_cat H5. 
uh H5; ee; am.
app gz_loc_axioms. am. 
uh H10. ee. 
wr H7. ap H13. am. am. am. 


assert (loc_compatible a s f).
uhg; ee. 
am. am. am. 
rw H5. am. 

ee. 
uf ob_image. 
ap Z_inc. 
rw target_pull_morphism. 
ap ob_is_ob. 
rw source_gz_proj. 
rw ob_functor_cat. uhg; ee. am. 
am. am. am. am. am. 

sh (gz_dotted a s f). 
ee. 
rw source_pull_morphism. 
rw target_gz_proj. 
rw ob_functor_cat. 
uhg; ee. 
app gz_dotted_axioms. 
rww source_gz_dotted. 
rww target_gz_dotted. 
app gz_loc_axioms. am. am. 

rw fob_pull_morphism. 
rw fcompose_gz_dotted_gz_proj. tv. 
am. app gz_proj_axioms. am. 
rw target_gz_proj. 
rw ob_functor_cat. 
uhg; ee. 
app gz_dotted_axioms. 
rww source_gz_dotted. 
rww target_gz_dotted. 
app gz_loc_axioms. am. am. 
Qed.


End GZ_Thm.



(*****************************************************************************************)
(*****************************************************************************************)
(*****************************************************************************************)
(*****************************************************************************************)

Module Left_Fractions.
Export GZ_Def. 

Definition lf_symbol f t :=
Arrow.create (source f) (source t) (pair f t).

Definition lf_forward v := pr1 (arrow v).
Definition lf_backward v := pr2 (arrow v).

Lemma source_lf_symbol : forall f t, source (lf_symbol f t) 
= source f.
Proof.
ir. uf lf_symbol. rww Arrow.source_create. 
Qed.

Lemma target_lf_symbol : forall f t, target (lf_symbol f t)
= source t.
Proof.
ir. uf lf_symbol. rww Arrow.target_create. 
Qed.

Lemma lf_forward_lf_symbol : forall f t, lf_forward
(lf_symbol f t) = f.
Proof.
ir. uf lf_symbol. uf lf_forward. 
rw Arrow.arrow_create. rww pr1_pair. 
Qed.

Lemma lf_backward_lf_symbol : forall f t, lf_backward 
(lf_symbol f t) = t.
Proof.
ir. uf lf_symbol. uf lf_backward. 
rw Arrow.arrow_create. rww pr2_pair. 
Qed. 

Definition lf_symbol_like v :=
v = lf_symbol (lf_forward v) (lf_backward v).

Lemma lf_symbol_like_lf_symbol : forall f t,
lf_symbol_like (lf_symbol f t).
Proof.
ir. uf lf_symbol_like. 
rw lf_forward_lf_symbol. rw lf_backward_lf_symbol. tv. 
Qed. 

Definition lf_symbol_property a s f t :=
localizing_system a s &
mor a f & inc t s & target f = target t.

Definition is_lf_symbol a s v :=
lf_symbol_like v & lf_symbol_property a s (lf_forward v)
(lf_backward v).

Lemma is_lf_symbol_lf_symbol : forall a s f t,
lf_symbol_property a s f t ->
is_lf_symbol a s (lf_symbol f t).
Proof.
ir. uhg; ee. ap lf_symbol_like_lf_symbol. 
rw lf_forward_lf_symbol. rw lf_backward_lf_symbol. 
am. 
Qed. 

Definition multiplicative_system a s :=
localizing_system a s &
(forall y z, inc y s -> inc z s -> 
source y = target z -> inc (comp a y z) s).

Definition has_left_fractions a s :=
multiplicative_system a s 
&
(forall x, ob a x -> inc (id a x) s) 
&
(forall r g, inc r s -> mor a g -> source r = source g ->
exists u, (is_lf_symbol a s u & source u = target r
& target u = target g & comp a (lf_backward u) g =
comp a (lf_forward u) r)) 
&
(forall v r t, inc v s -> mor a r -> mor a t ->
source r = target v -> source t = target v ->
comp a r v = comp a t v -> 
exists w, (inc w s & source w = target r & source w = target t
& comp a w r = comp a w t)).

Definition lf_choice a s r g :=
choose (fun u => (is_lf_symbol a s u & source u = target r
& target u = target g & comp a (lf_backward u) g =
comp a (lf_forward u) r)).

Lemma is_lf_symbol_lf_choice : forall a s r g,
has_left_fractions a s ->
inc r s -> mor a g -> source r = source g ->
is_lf_symbol a s (lf_choice a s r g).
Proof.
ir. 
assert ((fun u : E =>
      is_lf_symbol a s u &
      source u = target r &
      target u = target g &
      comp a (lf_backward u) g = comp a (lf_forward u) r) 
(lf_choice a s r g)). 
uf lf_choice. ap choose_pr. 
uh H; ee. au. 
cbv beta in H3. ee. am. 
Qed.

Lemma source_lf_choice : forall a s r g,
has_left_fractions a s ->
inc r s -> mor a g -> source r = source g ->
source (lf_choice a s r g) = target r.
Proof.
ir. 
assert ((fun u : E =>
      is_lf_symbol a s u &
      source u = target r &
      target u = target g &
      comp a (lf_backward u) g = comp a (lf_forward u) r) 
(lf_choice a s r g)). 
uf lf_choice. ap choose_pr. 
uh H; ee. au. 
cbv beta in H3. ee. am. 
Qed.

Lemma target_lf_choice : forall a s r g,
has_left_fractions a s ->
inc r s -> mor a g -> source r = source g ->
target (lf_choice a s r g) = target g.
Proof.
ir. 
assert ((fun u : E =>
      is_lf_symbol a s u &
      source u = target r &
      target u = target g &
      comp a (lf_backward u) g = comp a (lf_forward u) r) 
(lf_choice a s r g)). 
uf lf_choice. ap choose_pr. 
uh H; ee. au. 
cbv beta in H3. ee. am. 
Qed.

Lemma comp_lf_backward_lf_choice : forall a s r g,
has_left_fractions a s ->
inc r s -> mor a g -> source r = source g ->
comp a (lf_backward (lf_choice a s r g)) g
 = comp a (lf_forward (lf_choice a s r g)) r.
Proof.
ir. 
assert ((fun u : E =>
      is_lf_symbol a s u &
      source u = target r &
      target u = target g &
      comp a (lf_backward u) g = comp a (lf_forward u) r) 
(lf_choice a s r g)). 
uf lf_choice. ap choose_pr. 
uh H; ee. au. 
cbv beta in H3. ee. am. 
Qed.




Lemma source_lf_forward : forall v,
lf_symbol_like v -> source (lf_forward v) = source v.
Proof.
ir. uh H; ee. rw H. rw lf_forward_lf_symbol. 
rw source_lf_symbol. tv. 
Qed.

Lemma source_lf_backward : forall v,
lf_symbol_like v -> source (lf_backward v) = target v.
Proof.
ir. uh H; ee. rw H. rw lf_backward_lf_symbol. 
rw target_lf_symbol. tv. 
Qed. 


Lemma inc_ms_mor : forall a u,
(exists s, (localizing_system a s & inc u s)) ->
mor a u.
Proof.
ir. nin H. ee. 
uh H; ee. ap H1; am. 
Qed. 

Lemma inc_hlf_mor : forall a u,
(exists s, (has_left_fractions a s & inc u s)) ->
mor a u.
Proof.
ir. nin H. ee. 
ap inc_ms_mor. sh x. ee. lu. am. 
Qed. 



Definition lf_id_rep a x :=
lf_symbol (id a x) (id a x).

Lemma source_lf_id_rep : forall a x, 
ob a x -> source (lf_id_rep a x) = x.
Proof.
ir. uf lf_id_rep. rww source_lf_symbol. 
rww source_id. 
Qed.

Lemma target_lf_id_rep : forall a x, 
ob a x -> target (lf_id_rep a x) = x.
Proof.
ir. uf lf_id_rep. rww target_lf_symbol. 
rww source_id. 
Qed.

Lemma is_lf_symbol_lf_id_rep : forall a s x,
has_left_fractions a s -> ob a x ->
is_lf_symbol a s (lf_id_rep a x).
Proof.
ir. uf lf_id_rep. 
ap is_lf_symbol_lf_symbol. uhg; ee. 
lu. app mor_id. uh H; ee. uh H; ee. 
au. tv. 
Qed.

Definition lf_vertex v :=
target (lf_backward v).

Lemma target_lf_forward : forall u,
(exists a, exists s, (is_lf_symbol a s u)) ->
target (lf_forward u) = lf_vertex u.
Proof.
ir. nin H. nin H. uh H; ee. 
uf lf_vertex. uh H0; ee; am. 
Qed.

Lemma target_lf_backward : forall u,
target (lf_backward u) = lf_vertex u.
Proof.
ir. tv. 
Qed. 

Definition lf_extend a (s:E) p u :=
lf_symbol (comp a p (lf_forward u)) (comp a p (lf_backward u)).

Lemma mor_lf_forward : forall a u,
(exists s, is_lf_symbol a s u) -> 
mor a (lf_forward u).
Proof.
ir. nin H. uh H; ee. uh H0; ee; am. 
Qed.

Lemma inc_lf_backward : forall s u,
(exists a, is_lf_symbol a s u) ->
inc (lf_backward u) s.
Proof.
ir. nin H. uh H; ee. uh H0; ee; am. 
Qed. 



Lemma mor_lf_backward : forall a u,
(exists s, is_lf_symbol a s u) -> 
mor a (lf_backward u).
Proof.
ir. nin H. uh H; ee. uh H0; ee. 
ap inc_ms_mor. sh x. ee. am. 
am. 
Qed. 

Lemma is_lf_symbol_lf_extend : forall a s p u,
has_left_fractions a s -> 
is_lf_symbol a s u -> 
mor a p -> source p = lf_vertex u ->
inc (comp a p (lf_backward u)) s -> 
is_lf_symbol a s (lf_extend a s p u).
Proof.
ir. 

uf lf_extend. 
ap is_lf_symbol_lf_symbol. uhg; ee. 
lu. rw mor_comp. tv. am. ap mor_lf_forward.
sh s; am. 
rw target_lf_forward. am. 
sh a. sh s. am. tv. 
uh H; ee. uh H; ee. am.  
rw target_comp. rw target_comp. tv. am. 
ap mor_lf_backward. sh s; am. am. am. 
ap mor_lf_forward. sh s; am. rw target_lf_forward.
am. sh a. sh s; am. 
Qed.

Lemma source_lf_extend : forall a s p u,
is_lf_symbol a s u ->
mor a p -> source p = lf_vertex u -> 
source (lf_extend a s p u) = source u.
Proof.
ir. 

uf lf_extend. 
rw source_lf_symbol. rw source_comp. 
rw source_lf_forward. tv. lu. 
am. ap mor_lf_forward. sh s; am. 
rw target_lf_forward. am. 
sh a. sh s; am. 
Qed.

Lemma target_lf_extend : forall a s p u,
is_lf_symbol a s u ->
mor a p -> source p = lf_vertex u -> 
target (lf_extend a s p u) = target u.
Proof.
ir. 

uf lf_extend. 
rw target_lf_symbol. rw source_comp. 
rw source_lf_backward. tv. lu. 
am. ap mor_lf_backward. sh s; am. 
rw target_lf_backward. am. 
Qed.

Lemma lf_forward_lf_extend : forall a s p u,
lf_forward (lf_extend a s p u) = comp a p (lf_forward u).
Proof.
ir. uf lf_extend. 
rw lf_forward_lf_symbol. tv. 
Qed.

Lemma lf_backward_lf_extend : forall a s p u,
lf_backward (lf_extend a s p u) = comp a p (lf_backward u).
Proof.
ir. uf lf_extend. 
rw lf_backward_lf_symbol. tv. 
Qed. 

Lemma lf_vertex_lf_extend : forall a s p u,
has_left_fractions a s ->
is_lf_symbol a s u -> mor a p -> source p = lf_vertex u ->
lf_vertex (lf_extend a s p u) = target p.
Proof.
ir. uf lf_vertex. 
rw lf_backward_lf_extend. 
rw target_comp. tv. am. 
ap mor_lf_backward. sh s; am. am. 
Qed.

(** Gabriel-Zisman don't explain this very well but we
need two notions which are slightly different. The
weaker notion which we call [lf_beyond] means that
there is just an arrow going from the vertex of [u]
to the vertex of [v] (making everything 
commute). The stronger notion which we call
[lf_under] means that there is such an arrow which is
in [s]. Of course if [s] satisfied 3 for the price of 2
then these would be equivalent but Gabriel-Zisman
claim to do the theory without this condition and we 
try to follow. *)

Definition lf_beyond a s u v :=
has_left_fractions a s &
is_lf_symbol a s u & is_lf_symbol a s v &
source u = source v & target u = target v &
(exists p, (mor a p & source p = lf_vertex u &
lf_extend a s p u = v)).

Definition lf_under a s u v :=
has_left_fractions a s &
is_lf_symbol a s u & is_lf_symbol a s v &
source u = source v & target u = target v &
(exists p, (inc p s & source p = lf_vertex u &
lf_extend a s p u = v)).

Lemma lf_under_lf_beyond : forall a s u v,
lf_under a s u v -> lf_beyond a s u v.
Proof.
ir. uh H; uhg; ee; try am. 
nin H4. ee.
sh x. ee; try am. ap inc_hlf_mor. 
sh s; ee; am. 
Qed.



Lemma lf_beyond_lf_extend : forall a s p u,
has_left_fractions a s -> 
is_lf_symbol a s u -> mor a p ->
source p = lf_vertex u ->
inc (comp a p (lf_backward u)) s -> 
lf_beyond a s u (lf_extend a s p u).
Proof.
ir. 
uhg; ee. am. am. 
app is_lf_symbol_lf_extend. 
rww source_lf_extend. rww target_lf_extend. 
sh p. ee; try am. tv. 
Qed. 

Lemma inc_comp : forall a s u v,
multiplicative_system a s ->
inc u s ->  inc v s -> source u = target v ->
inc (comp a u v) s.
Proof.
ir. uh H; ee; au. 
Qed. 

Lemma lf_under_lf_extend : forall a s p u,
has_left_fractions a s -> 
is_lf_symbol a s u -> inc p s ->
source p = lf_vertex u ->
lf_under a s u (lf_extend a s p u).
Proof.
ir. 
uhg; ee. am. am. 
app is_lf_symbol_lf_extend. 
ap inc_hlf_mor. sh s; ee; am. 
ap inc_comp. lu. 
am. 
ap inc_lf_backward. 
sh a; am. 
rw target_lf_backward. am. 
rww source_lf_extend. 
ap inc_hlf_mor. sh s; ee; am. 
rww target_lf_extend. ap inc_hlf_mor. sh s; ee; am. 
sh p. ee; try am. tv. 
Qed. 

Lemma lf_symbol_like_extens : forall u v,
lf_symbol_like u -> lf_symbol_like v ->
lf_forward u = lf_forward v -> lf_backward u = lf_backward v ->
u = v.
Proof.
ir. uh H; uh H0; ee. 
rw H; rw H0. rw H1; rw H2. reflexivity. 
Qed.

Lemma lf_symbol_like_lf_extend : forall a s p u,
lf_symbol_like (lf_extend a s p u).
Proof.
ir. uf lf_extend. 
ap  lf_symbol_like_lf_symbol. 
Qed. 

Lemma lf_extend_comp : forall a s u p q,
is_lf_symbol a s u ->
mor a p -> mor a q -> 
source q = lf_vertex u -> 
source p = target q ->
lf_extend a s (comp a p q) u =
lf_extend a s p (lf_extend a s q u).
Proof.
ir. 
ap lf_symbol_like_extens.
ap lf_symbol_like_lf_extend.
ap lf_symbol_like_lf_extend.
rw lf_forward_lf_extend. rw lf_forward_lf_extend.
rw lf_forward_lf_extend. 
rww assoc. uh H; ee. uh H4; ee; am. 
rw target_lf_forward. am. 
sh a. sh s. am. 
rw lf_backward_lf_extend. rw lf_backward_lf_extend.
rw lf_backward_lf_extend. 
rww assoc. uh H; ee. uh H4; ee. 
ap inc_ms_mor. sh s. ee; am. 
Qed.



Lemma lf_beyond_trans : forall a s u v w,
lf_beyond a s u v -> lf_beyond a s v w ->
lf_beyond a s u w.
Proof.
ir. 
uh H; uh H0; ee. nin H10; nin H5; ee.
uhg; ee; try am. 
rww H8. rww H9. 
assert (source x0 = target x).
transitivity (lf_vertex v).
am. wr H14. 
rw lf_vertex_lf_extend. 
tv. am. am. am. am. 

sh (comp a x0 x).
ee. 
rww  mor_comp. 
rww source_comp. 
rw lf_extend_comp. 
rw H14. rw H12. tv. 
am. am. am. am. am. 
Qed. 

Lemma exists_lf_under : forall a s u v,
lf_beyond a s u v -> exists w,
(lf_beyond a s v w & lf_under a s u w).
Proof.
ir. 
assert (lem1 : has_left_fractions a s).
lu. 
uh lem1; ee. 
util (H2 (lf_backward v) (lf_backward u)).
ap inc_lf_backward. sh a; lu. 
ap mor_lf_backward. sh s; lu. 
rw source_lf_backward. rw source_lf_backward.
uh H; ee. sy; am. uh H; ee. uh H4; ee; am. 
uh H; ee. uh H5; ee; am. 

nin H4. ee. 
uh H; ee. 
nin H12. ee. 

assert (source x = target x0).
transitivity (lf_vertex v).
am. wr H14. 
rw lf_vertex_lf_extend. tv. am. 
am. am. am. 

assert (lem2 : source x0 = target x).
rw H6. am. 



util (H3 
(lf_backward u) (lf_backward x) (comp a (lf_forward x) x0)).

ap inc_lf_backward. sh a; am. 
ap mor_lf_backward. sh s; am. 
rw mor_comp. tv. 
ap mor_lf_forward. sh s; am. 
am. rw source_lf_forward. 
am. 
uh H4; ee; am. 
tv. 
rw source_lf_backward. tv. 
uh H4; ee; am. 
rw source_comp. rw H13. tv. 
ap mor_lf_forward. sh s; am. am. 
rw source_lf_forward. am. 
uh H4; ee; am. 

util H16. rw assoc. 
assert (comp a x0 (lf_backward u) = 
lf_backward v). 
wr H14. rw lf_backward_lf_extend. tv. 
rw H17. am. 
ap mor_lf_forward. sh s; am. 
am. ap mor_lf_backward. sh s; am. 
rw source_lf_forward. am. 
uh H4; ee; am. 
wr H6. am.   
tv. clear H16. 
nin H17. 
ee. 

assert (mor a x1).
ap inc_hlf_mor. sh s; ee; am. 

assert (mor a (lf_forward x)).
ap mor_lf_forward. sh s; am. 

assert (mor a (lf_backward x)).
ap mor_lf_backward. sh s; am. 

assert (source x1 = target (lf_forward x)).
rw target_lf_forward. am. 
sh a; sh s; am. 


assert (lem3 : 
lf_extend a s (comp a x1 (lf_backward x)) u =
lf_extend a s (comp a x1 (lf_forward x)) v).
rw H19. 
wr assoc. 
rw lf_extend_comp. 
rw H14. reflexivity. 
am. 
rw mor_comp. tv. am. 
am. 
am. tv. 
am. am. 
rw source_comp. rw source_lf_forward. am. 
uh H4; ee; am. am. am. 
am. 
am. am. 
am. am. 
rww source_lf_forward. uh H4; ee; am. tv. 


sh (lf_extend a s (comp a x1 (lf_backward x)) u).
ee. 
rw lem3. 
ap lf_beyond_lf_extend. am. 
am. rww mor_comp. 
rww source_comp. 
rw source_lf_forward. am. uh H4; ee; am. 

rw assoc. wr H7. 
ap inc_comp. uh H; ee; am. am. 
ap  inc_comp. uh H; ee; am. 
ap inc_lf_backward. sh a; am. 
ap inc_lf_backward. sh a; am. 
wr H6. 
rw source_lf_backward. tv. uh H4; ee; am. 
rw target_comp. am. 
am. 
ap mor_lf_backward. sh s; am.  
rw source_lf_backward. rw target_lf_backward. 
am. uh H4; ee; am. am. 
am. ap mor_lf_backward. sh s; am. 
rw target_lf_forward. am. 
sh a; sh s; am. 

rw source_lf_forward. rw target_lf_backward. 
am. uh H4; ee; am. tv. 

ap  lf_under_lf_extend. 
am. am. ap inc_comp. 
uh H; ee; am. am. 
ap inc_lf_backward. sh a; am. 
am. 
rw source_comp. rw source_lf_backward. am. uh H4; ee; am. 
am. am. 
am. 
Qed. 

Definition lf_equiv a s u v :=
(exists w, (lf_beyond a s u w & lf_beyond a s v w)).


Lemma lf_equiv_symm : forall a s u v,
lf_equiv a s u v -> lf_equiv a s v u.
Proof.
ir. uh H; uhg. nin H. sh x. xd. 
Qed.

Lemma  lf_extend_id : forall a s u,
is_lf_symbol a s u -> 
lf_extend a s (id a (lf_vertex u)) u = u.
Proof.
ir. 
assert (ob a (lf_vertex u)). 
uf lf_vertex. rw ob_target. tv. 
ap mor_lf_backward. sh s; am. 

ap lf_symbol_like_extens. 
ap lf_symbol_like_lf_extend. 
uh H; ee; am. 
rw lf_forward_lf_extend. 
rw left_id. tv. am. 
ap  mor_lf_forward. sh s; am. 
rw target_lf_forward. tv. sh a; sh s; am. tv. 

rw lf_backward_lf_extend. rw left_id. 
tv. am. ap mor_lf_backward. sh s; am. 
rw target_lf_backward. tv. tv. 
Qed. 

Lemma lf_equiv_refl : forall a s u,
has_left_fractions a s -> 
is_lf_symbol a s u -> lf_equiv a s u u.
Proof.
ir. uhg. sh u. 
assert (ob a (lf_vertex u)).
uf lf_vertex. rw ob_target. tv. 
ap mor_lf_backward. sh s; am. 

dj. uhg; ee. 
am. am. am. tv. tv. 
sh (id a (lf_vertex u)). 
ee. ap mor_id. am. 
rww source_id. 
rw lf_extend_id. tv. am. am. 
Qed.

Lemma lf_beyond_refl : forall a s u,
has_left_fractions a s -> 
is_lf_symbol a s u -> lf_beyond a s u u.
Proof.
ir. assert (ob a (lf_vertex u)).
uf lf_vertex. rw ob_target. tv. 
ap mor_lf_backward. sh s; am. 

dj. uhg; ee. 
am. am. am. tv. tv. 
sh (id a (lf_vertex u)). 
ee. ap mor_id. am. 
rww source_id. 
rw lf_extend_id. tv. am. 
Qed. 



Lemma lf_equiv_beyond_under : forall a s u v,
lf_equiv a s u v -> exists w,
(lf_beyond a s u w & lf_under a s v w).
Proof.
ir. 
uh H. nin H. 
ee. 
cp (exists_lf_under H0). nin H1. 
ee. sh x0. ee. 
apply lf_beyond_trans with x. am. am. am. 
Qed.


Lemma exists_lf_further : forall a s u v w,
lf_beyond a s u v -> lf_under a s u w ->
exists z, (lf_beyond a s v z & lf_beyond a s w z).
Proof.
ir. uh H; uh H0; nin H; nin H0; ee.
nin H6; nin H10; ee. 
set (p:= lf_choice a s x x0).
set (e:= lf_backward p).
set (f:= lf_forward p).

assert (source x = source x0). 
rw H13. am. 

assert (is_lf_symbol a s p).
uf p. ap is_lf_symbol_lf_choice. 
am. am. am. am. 

assert (mor a e). 
uf e. ap mor_lf_backward. sh s; am.

assert (mor a f).
uf f. ap mor_lf_forward. sh s; am. 

assert (inc e s).
uf e. ap inc_lf_backward. sh a; am. 

assert (mor a x).
ap inc_hlf_mor. sh s; ee; am. 

assert (target x = lf_vertex w).
wr H12. rw lf_vertex_lf_extend. tv. 
am. am. am. am. 

assert (target x0 = lf_vertex v). 
wr H14. rw lf_vertex_lf_extend. tv. 
am. am. am. wrr H15. 

assert (target p = lf_vertex v). 
uf p. rww target_lf_choice. 

assert (source p = lf_vertex w). 
uf p. rww source_lf_choice. 

assert (source e = target x0).
rww H22. uf e. rww source_lf_backward.
uh H16; ee; am. 

assert (lf_vertex p = target f).
uf f. rww target_lf_forward. 
sh a; sh s; am. 

assert (target e = target f).
uf e. rww target_lf_backward. 

assert (source f = target x).
uf f. rww source_lf_forward. 
rww H24. sy; am. uh H16; ee; am. 

assert (source e = lf_vertex v).
rww H25. 

assert (source f = lf_vertex w).
rww H28. 

assert (comp a f x = comp a e x0).
uf f. uf e. 
uf p. sy. 
ap comp_lf_backward_lf_choice. am. 
am. am. am. 

assert (lf_extend a s e v = lf_extend a s f w).
transitivity (lf_extend a s (comp a e x0) u).
rw lf_extend_comp. rw H14. tv. 
am. am. am. am. am. 
wr H31. rw lf_extend_comp. 
rw H12. tv. am. am. am. am. am. 

sh (lf_extend a s e v). 
dj. ap lf_under_lf_beyond. 
ap lf_under_lf_extend. am. am. am. am. 

assert (localizing_system a s).
lu. 

rw H32. ap lf_beyond_lf_extend. 
am. am. am. am. 
rewrite <- lf_backward_lf_extend with (s:=s). 
wr H32. uh H33. ee. uh H36; ee. 
uh H40; ee. am. 
Qed. 








Lemma lf_equiv_trans : forall a s u w,
has_left_fractions a s -> 
(exists v, (lf_equiv a s u v & lf_equiv a s v w)) ->
lf_equiv a s u w.
Proof.
ir. nin H0. 
ee. cp (lf_equiv_beyond_under H0). 
cp (lf_equiv_beyond_under H1). 
nin H2. nin H3. ee. 
cp (exists_lf_further H3 H5). 
nin H6. ee. 

uhg. sh x2. ee. 
apply lf_beyond_trans with x0. am. 
am. 
apply lf_beyond_trans with x1. 
ap lf_under_lf_beyond. am. am. 
Qed.



(** Now we come to the definition of the composition
representative, and the proof that equivalent [lf_symbol]'s
give equivalent [lf_comp_rep]'s. ********************)

Definition fills_in a s u v w :=
has_left_fractions a s &
is_lf_symbol a s u & is_lf_symbol a s v & is_lf_symbol a s w
& source u = target v & source w = lf_vertex v &
target w = lf_vertex u & 
comp a (lf_forward w) (lf_backward v) =
comp a (lf_backward w) (lf_forward u).

Definition lf_filler a s u v := 
lf_choice a s (lf_backward v) (lf_forward u). 

Definition lf_make_comp a (s:E) u v w :=
lf_symbol (comp a (lf_forward w) (lf_forward v))
(comp a (lf_backward w) (lf_backward u)).

Definition lf_comp_rep a s u v := 
lf_make_comp a s u v (lf_filler a s u v).


Lemma fills_in_lf_filler : forall a s u v,
has_left_fractions a s ->
is_lf_symbol a s u -> is_lf_symbol a s v ->
source u = target v ->
fills_in a s u v (lf_filler a s u v).
Proof.
ir. uf lf_filler. 
uhg; ee. 
am. am. am. 
ap is_lf_symbol_lf_choice. am. 
uh H1; ee. uh H3; ee; am. 
uh H0; ee. uh H3; ee; am. 
rw source_lf_backward. rw source_lf_forward. 
sy; am. uh H0; ee; am. uh H1; ee; am. 
am. 
rw source_lf_choice. 
tv. am. uh H1; ee. uh H3; ee; am. 
uh H0; ee. uh H3; ee; am. 
rw source_lf_backward. 
rw source_lf_forward. sy; am. 
uh H0; ee; am. uh H1; ee; am. 

rw target_lf_choice. rw target_lf_forward. 
tv. sh a; sh s; am. am. 
uh H1; ee; uh H3; ee; am. 
uh H0; ee;  uh H3; ee; am. 
rw source_lf_backward. rw source_lf_forward. 
sy; am. uh H0; ee; am. 
uh H1; ee; am. 
rw comp_lf_backward_lf_choice. tv. 
am. uh H1; ee; uh H3; ee; am. 
uh H0; ee; uh H3; ee; am. 
rw source_lf_backward. rw source_lf_forward. 
sy; am. uh H0; ee; am. uh H1; ee; am. 
Qed.

Lemma source_lf_make_comp : forall a s u v w,
fills_in a s u v w -> 
source (lf_make_comp a s u v w) = source v.
Proof.
ir. 
uh H; ee. 
uf lf_make_comp. 
rw source_lf_symbol. 
rw source_comp. 
rw source_lf_forward. tv. 
uh H1; ee; am. 
uh H2; ee. uh H7; ee; am. 
uh H1; ee; uh H7; ee; am. 
rw source_lf_forward. 
rw target_lf_forward. am. sh a; sh s; am. 
uh H2; ee; am. 
Qed.

Lemma target_lf_make_comp : forall a s u v w,
fills_in a s u v w ->
target (lf_make_comp a s u v w) = target u.
Proof.
ir. 
uh H; ee. 
uh H0; uh H1; uh H2; ee.
uh H7; uh H8; uh H9; ee. 
uf lf_make_comp. 
rw target_lf_symbol. 
rww source_comp. 
rw source_lf_backward. tv. 
am. ap inc_hlf_mor. sh s; ee; am. 
ap inc_hlf_mor; sh s; ee; am. 
rww source_lf_backward. 
Qed.

Lemma lf_vertex_lf_make_comp : forall a s u v w,
fills_in a s u v w -> 
lf_vertex (lf_make_comp a s u v w) =
lf_vertex w. 
Proof.
ir. 
uf lf_vertex. 
uf lf_make_comp.
rw lf_backward_lf_symbol. 
uh H; ee. 
rw target_comp. tv. 
ap mor_lf_backward. 
sh s. am. 
ap mor_lf_backward. 
sh s. am. 
rw source_lf_backward. rw target_lf_backward. 
am. uh H2; ee; am. 
Qed.


Lemma is_lf_symbol_lf_make_comp : forall a s u v w,
fills_in a s u v w -> 
is_lf_symbol a s (lf_make_comp a s u v w).
Proof.
ir. uh H; ee. 
uh H0; uh H1; uh H2; ee.
uh H7; uh H8; uh H9; ee. 
uf lf_make_comp. 
ap is_lf_symbol_lf_symbol. 
uhg; ee. lu. 
rww mor_comp. 
rww source_lf_forward. rww target_lf_forward. 
sh a; sh s.
uhg; ee; try am. uhg; ee; try am. 
app inc_comp. uh H; ee; am. 
rww source_lf_backward. rww target_comp. 
rww target_lf_forward. 
rww target_comp. ap inc_hlf_mor.
sh s; ee; am. ap inc_hlf_mor; sh s; ee; am. 
rww source_lf_backward. sh a; sh s.
uhg; ee; try am. uhg; ee; am. 
rww source_lf_forward. rww target_lf_forward.
sh a; sh s. uhg; ee; try am. 
uhg; ee; am.  
Qed. 

Lemma lf_forward_lf_make_comp : forall a s u v w,
lf_forward (lf_make_comp a s u v w) = 
comp a (lf_forward w) (lf_forward v).
Proof.
ir. 
uf lf_make_comp. rww lf_forward_lf_symbol. 
Qed. 

Lemma lf_backward_lf_make_comp : forall a s u v w,
lf_backward (lf_make_comp a s u v w) = 
comp a (lf_backward w) (lf_backward u).
Proof.
ir. 
uf lf_make_comp. rww lf_backward_lf_symbol. 
Qed. 


Lemma lf_beyond_fills_in : forall a s u v w,
(exists y, (fills_in a s u v y & 
lf_beyond a s y w)) -> 
fills_in a s u v w.
Proof.
ir. nin H. 
ee. 
uh H; ee. 
uh H0. ee. nin H12. 
ee. 
uhg; ee; try am. 
wrr H10.  wrr H11. 
wr H14. 
rw lf_forward_lf_extend. 
rw lf_backward_lf_extend. 

assert (mor a (lf_forward x)).
uh H3; ee. uh H15; ee; am. 
assert (mor a (lf_forward u)).
uh H1; ee. uh H16; ee; am. 
assert (mor a (lf_backward x)).
ap mor_lf_backward. sh s; am. 
assert (mor a (lf_backward v)).
ap mor_lf_backward. sh s; am. 

rw assoc. rw H7. 
rww assoc. 
rw source_lf_backward. rw target_lf_forward.
am. sh a; sh s; am. uh H3; ee; am. 
am. am. am. 
rww target_lf_forward. 
sh a; sh s; am. 
rw source_lf_forward. rw target_lf_backward.
am. uh H3; ee; am. tv. 
Qed.

Lemma lf_beyond_lf_make_comp : forall a s u v w y,
fills_in a s u v w ->
lf_beyond a s w y ->
lf_beyond a s (lf_make_comp a s u v w) (lf_make_comp a s u v y).
Proof.
ir. 
cp H; cp H0. uh H1; uh H2; ee. 
nin H7; ee. 
assert (fills_in a s u v y).
ap lf_beyond_fills_in. sh w; ee; am. 
uhg; ee.
am. app is_lf_symbol_lf_make_comp.
app is_lf_symbol_lf_make_comp. 
rww source_lf_make_comp. rww source_lf_make_comp.
rww target_lf_make_comp. rww target_lf_make_comp.

sh x. ee. am. 
rww lf_vertex_lf_make_comp. 

ap lf_symbol_like_extens. 
ap lf_symbol_like_lf_extend. 
uf lf_make_comp. 
ap lf_symbol_like_lf_symbol. 
rw lf_forward_lf_extend. 
rw lf_forward_lf_make_comp. 
rw lf_forward_lf_make_comp. 
wr H16. 
rw lf_forward_lf_extend. 
sy; ap assoc. am. ap mor_lf_forward.
sh s; am. ap mor_lf_forward. 
sh s; am. rw target_lf_forward. am. 
sh a; sh s; am. rw source_lf_forward.
rw target_lf_forward. am. sh a; sh s; am.
uh H10; ee; am. tv. 

rw lf_backward_lf_extend. 
rw lf_backward_lf_make_comp.
rw lf_backward_lf_make_comp.
wr H16. rw lf_backward_lf_extend. 
sy; ap assoc. am. 
ap mor_lf_backward. sh s; am. 
ap mor_lf_backward. sh s; am. 
rw target_lf_backward. am. 
rw source_lf_backward. rw target_lf_backward. 
am. uh H10; ee; am. tv. 
Qed.

Definition lf_lean_to a s e f g h i j :=
has_left_fractions a s &
mor a e & mor a f & mor a g & mor a h & mor a i & mor a j &
inc e s & inc h s & 
source e = source f & source g = target e & source h = target f
& target g = target h & source i = target e & source j = target f
& target i = target j & 
comp a g e = comp a h f & comp a i e = comp a j f.

Lemma show_lf_lean_to : forall a s e f g h i j,
has_left_fractions a s ->
mor a f -> mor a g -> mor a i -> mor a j ->
inc e s -> inc h s ->
source e = source f -> source g = target e -> source h = target f
-> source i = target e -> source j = target f ->
comp a g e = comp a h f -> comp a i e = comp a j f->
lf_lean_to a s e f g h i j.
Proof.
ir. 
assert (mor a e).
ap inc_hlf_mor. sh s; ee; am. 
assert (mor a h).
ap inc_hlf_mor. sh s; ee; am. 
uhg; ee; try am.
transitivity (target (comp a g e)).
rww target_comp. rw H11. 
rww target_comp. 
transitivity (target (comp a i e)).
rww target_comp. rw H12. 
rww target_comp. 
Qed.

Definition closes_lf_lean_to a s e f g h i j k l :=
lf_lean_to a s e f g h i j &
mor a k & mor a l & inc l s & 
source k = target g & source l = target i &
target k = target l &
comp a k g = comp a l i & comp a k h = comp a l j.

(*** The following is one of the key arguments.
It uses both existence conditions in the [has_left_fractions] 
condition.
*************************************************)

Lemma lf_lean_to_closure : forall a s e f g h i j,
lf_lean_to a s e f g h i j -> 
(exists k, exists l,(closes_lf_lean_to a s e f g h i j k l)).
Proof.
ir. 
uh H; ee. 

assert (source h = source j). 
rww H13. 


set (w := lf_choice a s h j). 
assert (is_lf_symbol a s w). 
uf w. app is_lf_symbol_lf_choice. 

assert (source w = target h).
uf w. rww source_lf_choice. 

assert (target w = target j).
uf w. rww target_lf_choice. 

set (p:= lf_forward w).
set (q:= lf_backward w).

assert  (mor a p).
uf p. ap mor_lf_forward. sh s; am. 

assert (mor a q).
uf q. ap mor_lf_backward. sh s; am. 

assert (inc q s).
uf q. ap inc_lf_backward. sh a; am. 

assert (source p = target h).
uf p. rww source_lf_forward. uh H18; ee; am. 

assert (source p = target g).
rww H11. 

assert (source q = target j).
uf q. rww source_lf_backward. uh H18; ee; am. 

assert (source q = target i).
rww H14. 

assert (target p = target q).
uf p; uf q. rww target_lf_forward. 
sh a; sh s; am. 

assert (comp a p h = comp a q j).
uf p; uf q. sy. uf w. 
app comp_lf_backward_lf_choice. 

set (r:= comp a p g).
set (t:= comp a q i).

assert (mor a r).
uf r. rww mor_comp. 

assert (mor a t).
uf t. rww mor_comp.

assert (source r = target e).
uf r. rww source_comp. 

assert (source t = target e).
uf t. rww source_comp.

assert (target r = target p).
uf r. rww target_comp. 

assert (target t = target p).
uf t. rww target_comp.
sy; am. 

assert (target r = target t).
rww H35. 

(** Now is where we do the first diagram-chase **)

assert (comp a r e = comp a t e).
uf r. uf t. 
rww assoc. rw H15. 
wr assoc. rw H29. rww assoc. 
wr H16. rww assoc. am. am. am. 
am. am. tv. 


(** Now apply the hlf condition to get an 
arrow [x] which equalizes [r] and [t] on the left **)

cp H. uh H38. ee. 
util (H41 e r t). am. am. am. am. 
am. cp (H42 H37). clear H38 H39 H40 H41 H42. 
nin H43. ee. 

assert (mor a x).
ap inc_hlf_mor. sh s; ee; am. 
assert (source x = target p).
rww H39. 
assert (source x = target q).
rww H39. wrr H28. 

(** Now to finish the answer is the pair of arrows obtained
from [p] and [q] by composing with [x]. ***)

sh (comp a x p).
sh (comp a x q).
uhg; ee. 
uhg; ee; am. 
rww mor_comp. 
rww mor_comp. 
app inc_comp. uh H; ee; am. 
rww source_comp. rww source_comp. 
rww target_comp. rww target_comp. 


rww assoc. 
rww assoc. 

rww assoc. rww assoc. 
rww H29.  
Qed. 

(**** Hopefully we will be able to take this out 
Lemma fills_in_equiv : forall a s w y,
(exists u, exists v, (fills_in a s u v w &
fills_in a s u v y)) ->
lf_equiv a s w y.
Proof.
(** Ideally we should use the previous lemma, added later;
for now to save time we include the old proof which basically
redoes the same thing more clumsily **)
ir. nin H. nin H. 
ee. cp H; cp H0; uh H; uh H0; ee.
set (p:= lf_backward x0).
set (q:= lf_forward x).
assert (mor a q).
uf q. ap mor_lf_forward. sh s; am. 

assert (inc p s).
uf p. ap inc_lf_backward. sh a; am. 

assert (mor a p).
uf p. ap mor_lf_backward. sh s; am. 

assert (source p = source q).
uf p; uf q. rw source_lf_backward. 
rw source_lf_forward. sy; am. 
uh H3; ee; am. uh H4; ee; am. 

assert (target p = source w).
uf p. rw target_lf_backward. 
sy; am. 

assert (target p = source y).
uf p. rw target_lf_backward. sy; am. 

assert (target q = target w).
uf q. rw target_lf_forward. sy; am. 
sh a; sh s; am. 

assert (target q = target y).
uf q. rw target_lf_forward. sy; am. 
sh a; sh s; am. 

assert (comp a (lf_forward w) p = comp a (lf_backward w) q).
am. 

assert (comp a (lf_forward y) p = comp a (lf_backward y) q).
am. 

set (b:= lf_choice a s (lf_backward y) (lf_backward w)).

assert (is_lf_symbol a s b).
uf b. ap is_lf_symbol_lf_choice. 
am. ap inc_lf_backward. sh a; am. 
ap mor_lf_backward. sh s; am. 
rw source_lf_backward. rw source_lf_backward. 
rww H15. uh H12; ee; am. uh H5; ee; am. 

assert (source b = lf_vertex y).
uf b. rw source_lf_choice. 
rw target_lf_backward. tv. 
am. ap inc_lf_backward. sh a; am. 
ap mor_lf_backward. sh s; am. 
rw source_lf_backward. rw source_lf_backward. 
rww H15. uh H12; ee; am. uh H5; ee; am. 

assert (target b = lf_vertex w).
uf b. rw target_lf_choice. 
tv. 
am. ap inc_lf_backward. sh a; am. 
ap mor_lf_backward. sh s; am. 
rw source_lf_backward. rw source_lf_backward. 
rww H15. uh H12; ee; am. uh H5; ee; am. 


assert (comp a (lf_forward b) (lf_backward y) = 
comp a (lf_backward b) (lf_backward w)). 
uf b. sy. 
ap comp_lf_backward_lf_choice. 
am. ap inc_lf_backward. sh a; am. 
ap mor_lf_backward. sh s; am. 
rw source_lf_backward. rw source_lf_backward. 
rww H15. uh H12; ee; am. uh H5; ee; am. 

set (r:= comp a (lf_forward b) (lf_forward y)).
set (t:= comp a (lf_backward b) (lf_forward w)).

assert (mor a (lf_forward b)). 
ap mor_lf_forward. sh s; am.

assert (mor a (lf_forward y)).
ap mor_lf_forward. sh s; am.

assert (mor a (lf_backward b)).
ap mor_lf_backward. sh s; am. 

assert (mor a (lf_forward w)).
ap mor_lf_forward. sh s; am.

assert (source (lf_forward b) = target (lf_forward y)).
rw source_lf_forward. rw target_lf_forward. am. 
sh a; sh s; am. uh H27; ee; am. 

assert (source (lf_backward b) = target (lf_forward w)).
rw source_lf_backward. rw target_lf_forward. am. 
sh a; sh s; am. uh H27; ee; am. 

assert (source r = target p).
uf r. rww source_comp.
rw source_lf_forward. am. uh H5; ee; am. 

assert (source t = target p).
uf t. rww source_comp.
rw source_lf_forward. am. uh H12; ee; am. 

assert (mor a r).
uf r. rww mor_comp. 


assert (mor a t).
uf t. rww mor_comp. 

assert (comp a r p = comp a t p).
uf r; uf t. 
rww assoc. rw H26. 
sy. rww assoc. rw H25. 
wrr assoc. sy. wr assoc. 
rw H30. reflexivity. 
am. ap mor_lf_backward. sh s; am. 
am. rw H35. rww target_lf_forward.
sh a; sh s; am. 
rw source_lf_backward. sy; am. 
uh H5; ee; am. tv. 
ap mor_lf_backward. sh s; am. 
rw H36. 
rw target_lf_forward. tv. 
sh a; sh s; am. rw source_lf_backward.
sy; am. uh H12; ee; am. rw source_lf_forward.
sy; am. uh H12; ee; am. 
rw source_lf_forward. sy; am. uh H5; ee; am. 


cp H0. uh H42. ee. clear H42 H43 H44. 
util (H45 p r t).
am. am. am. am. am. 
cp (H42 H41). nin H43. 
ee. 


uhg. 
sh (lf_extend a s (comp a x1 (lf_backward b)) w).
dj. 
ap lf_under_lf_beyond. 
ap lf_under_lf_extend. 
am. am. 
ap inc_comp. uh H0; ee; am. am. 
ap inc_lf_backward. sh a; am. 
rw target_lf_backward. rw H44. 
uf r. rww target_comp. 
rw target_lf_forward. tv. 
sh a; sh s; am. 

rw source_comp. 
rw source_lf_backward. am. 
uh H27; ee; am. 
ap inc_hlf_mor. sh s; ee; am. 
am. 
rw target_lf_backward. rw H44. 
uf r. rww target_comp. 
rw target_lf_forward. tv. 
sh a; sh s; am. 

assert (lf_symbol_like y).
uh H5; ee; am. 
assert (lf_symbol_like w).
uh H12; ee; am. 
assert (lf_symbol_like b). 
uh H27; ee; am. 

assert (mor a x1).
ap inc_hlf_mor. sh s; ee; am. 

assert (mor a (lf_backward y)).
ap mor_lf_backward. sh s; am. 

assert (mor a (lf_backward w)).
ap mor_lf_backward. sh s; am. 

assert (target r = lf_vertex b).
uf r. rww target_comp.
rww target_lf_forward. 
sh a; sh s; am. 

assert (target t = lf_vertex b). 
uf t. rww target_comp. 


assert (lf_extend a s (comp a x1 (lf_backward b)) w
= lf_extend a s (comp a x1 (lf_forward b)) y).
ap lf_symbol_like_extens. 
ap  lf_symbol_like_lf_extend.
 ap  lf_symbol_like_lf_extend.
rw lf_forward_lf_extend. 
rw lf_forward_lf_extend.

rw assoc. rw assoc. sy; am. 
am. am. am. 
rw target_lf_forward. rw H44. 
am. sh a; sh s; am. 
rw source_lf_forward. rw target_lf_forward.
am. sh a; sh s; am. am. tv. 
am. am. am. 
rw target_lf_backward. rw H44. am. 
rw source_lf_backward. 
rw target_lf_forward. am. 
sh a; sh s; am. 
am. tv. 

rw lf_backward_lf_extend. 
rw lf_backward_lf_extend. 
rw assoc. 
rw assoc. ap uneq. 
uf b. 
ap comp_lf_backward_lf_choice. 
am. ap inc_lf_backward. sh a; am. 
am. rww source_lf_backward. rww source_lf_backward.
rww H15. am. am. am. 
rww target_lf_forward. rw H44. am. 
sh a; sh s; am. 
rw source_lf_forward. 
rw target_lf_backward. 
am. am. tv. am. 
am. am. rww target_lf_backward. rw H44. am. 
rw source_lf_backward. rw target_lf_backward. 
am. am. tv. 

rw H57. 

ap lf_beyond_lf_extend. 
am. am. 
rww mor_comp. 
rww target_lf_forward. rww H44. 
sh a; sh s; am. 

rww source_comp. 
rww source_lf_forward. 
rw target_lf_forward. rww H44. 
sh a; sh s; am. 
rw assoc. 
rw H30. 

ap inc_comp. uh H0; ee; am. 
am. 
ap inc_comp. uh H0; ee; am. 
ap inc_lf_backward. sh a; am. 
ap inc_lf_backward. sh a; am. 
rw source_lf_backward. rw target_lf_backward. 
am. am. 
rww target_comp. 
rww target_lf_backward. rww H44. 
rww source_lf_backward. am. 
am. am. 
rww target_lf_forward. 
rww H44. sh a; sh s; am. 
rww source_lf_forward. 
tv. 
Qed.

********************)

(** The following redefinition
 is somewhat similar to the difference between [lf_beyond]
and [lf_under]. It seems that we need both stronger and
weaker versions of this type of notion, asking or not
that the filler arrow be in [s]. *****************)

Definition weakly_reps_lf_comp a s u v w :=
has_left_fractions a s &
is_lf_symbol a s u & is_lf_symbol a s v & is_lf_symbol a s w
& source u = target v & source w = source v &
target w = target u & 
(exists p, exists q,( mor a p & mor a q &
source p = lf_vertex v & source q = lf_vertex u &
target p = lf_vertex w & target q = lf_vertex w &
comp a p (lf_backward v) = comp a q (lf_forward u) &
comp a p (lf_forward v) = lf_forward w &
comp a q (lf_backward u) = lf_backward w)).


Lemma weak_rep_lf_equiv : forall a s u v w y,
fills_in a s u v y -> 
weakly_reps_lf_comp a s u v w ->
lf_equiv a s w (lf_make_comp a s u v y).
Proof.
ir.
uh H0; ee. 
nin H7; nin H7; ee.
assert (lf_lean_to a s (lf_backward v) (lf_forward u)
(lf_forward y) (lf_backward y) x x0).

cp H. uh H16; ee. 

ap show_lf_lean_to. 
am. ap mor_lf_forward. sh s; am. 
ap mor_lf_forward. sh s; am. 
am. am. 
ap inc_lf_backward. sh a. am. 
ap inc_lf_backward. sh a; am. 
rww source_lf_backward. rww source_lf_forward. 
sy; am. uh H17; ee; am. uh H18; ee; am. 
rww source_lf_forward. uh H19; ee; am.

rww source_lf_backward. rww target_lf_forward. 
sh a; sh s; am. uh H19; ee; am. 
rww target_lf_backward. rww target_lf_forward. 
sh a; sh s; am. 
am. am. 

cp (lf_lean_to_closure H16).
nin H17; nin H17. 
uh H17; ee. 

cp H. uh H26; ee. 

uhg. 
sh (lf_extend a s x2 w). 
dj. 

ap lf_under_lf_beyond. 
ap lf_under_lf_extend. am. 
am. am. rww H22. 

uhg; ee. am. 
app  is_lf_symbol_lf_make_comp. 
uh H34; ee; am. 
rw source_lf_make_comp. rw source_lf_extend.
sy; am. am. am. 
rww H22. am. 

rw target_lf_make_comp. rw target_lf_extend. 
sy; am. am. am. rww H22. am. 

sh x1. ee. am. 
rw lf_vertex_lf_make_comp. wr target_lf_forward. 
am. sh a; sh s; am. am. 

ap lf_symbol_like_extens. ap lf_symbol_like_lf_extend.
ap lf_symbol_like_lf_extend. 

rw lf_forward_lf_extend. rw lf_forward_lf_make_comp.
rw lf_forward_lf_extend. 
wr assoc. rw H24. rw assoc. wr H14. tv. 
am. am. ap mor_lf_forward. sh s; am. 
am. rww target_lf_forward. sh a; sh s; am. 
tv. am. ap mor_lf_forward. sh s; am. 
ap mor_lf_forward. sh s; am. 
am. 
rww source_lf_forward. rww target_lf_forward. 
sh a; sh s; am. uh H29; ee; am. tv. 


rw lf_backward_lf_extend. rw lf_backward_lf_make_comp.
rw lf_backward_lf_extend. wr assoc. rw H25. 
rw assoc. rw H15. tv. 
am. am. ap mor_lf_backward. sh s; am. 
rw H22. rww H12. 
rww target_lf_backward. tv. 
am. ap mor_lf_backward. sh s; am. 
ap mor_lf_backward. sh s; am. 
rw target_lf_backward. wr target_lf_forward. 
am. sh a; sh s; am. 
rw source_lf_backward. rw target_lf_backward. 
am. uh H29; ee; am. tv.   
Qed.

Lemma lf_beyond_weakly_reps_make_comp : forall a s u v w y,
lf_beyond a s u w -> fills_in a s w v y ->
weakly_reps_lf_comp a s u v (lf_make_comp a s w v y).
Proof.
ir. 
cp H; cp H0. 
uh H1; uh H2; nin H1; ee. nin H14; ee. 

uhg; ee. 
am. am. am. 
app is_lf_symbol_lf_make_comp. 
rww H12. 
rww source_lf_make_comp. rww target_lf_make_comp. 
sy; am. 
sh (lf_forward y).
sh (comp a (lf_backward y) x).

assert (target x = lf_vertex w).
wr H16. rww lf_vertex_lf_extend. 

assert (lf_symbol_like u).
uh H3; ee; am. 
assert (lf_symbol_like v).
uh H5; ee; am. 
assert (lf_symbol_like w).
uh H4; ee; am. 
assert (lf_symbol_like y).
uh H6; ee; am. 

assert (mor a (lf_backward y)). 
ap mor_lf_backward. sh s; am. 

assert (mor a (lf_forward y)). 
ap mor_lf_forward. sh s; am. 

(*** a lot of verifications but basically they are standard **)
ee. 
ap mor_lf_forward. sh s; am. 
rww mor_comp.  
rw source_lf_backward. rww H17. 
am. rww source_lf_forward. 

rw source_comp. am. am. am. 
rww source_lf_backward. rww H17. 
rww target_lf_forward. rww lf_vertex_lf_make_comp.
sh a; sh s; am. 
rww target_comp. rww target_lf_backward. 
rww lf_vertex_lf_make_comp. rww source_lf_backward.
rww H17. 
rw H10. sy. rw assoc. ap uneq. wr H16. 
rww lf_forward_lf_extend. am. am. 
ap mor_lf_forward. sh s; am. 
rww source_lf_backward. rww H17. rww target_lf_forward.
sh a; sh s; am. tv. 
rww lf_forward_lf_make_comp. 
rww lf_backward_lf_make_comp. 
wr H16. rw lf_backward_lf_extend. 
ap assoc. am. am. ap mor_lf_backward. sh s; am. 
rww source_lf_backward. rww H17. 
rww target_lf_backward. tv.  
Qed. 

Lemma weakly_reps_make_comp : forall a s u v y,
fills_in a s u v y -> 
weakly_reps_lf_comp a s u v (lf_make_comp a s u v y).
Proof.
ir. 
cp H. uh H0; ee. 
uhg; ee; try am. 
app is_lf_symbol_lf_make_comp. 
rww source_lf_make_comp. 
rww target_lf_make_comp. 

assert (lf_symbol_like y).
uh H3; ee; am. 

sh (lf_forward y).
sh (lf_backward y).
dj. 
ap mor_lf_forward. sh s. am. 
ap mor_lf_backward. sh s; am. 
rww source_lf_forward. 
rww source_lf_backward. 
rww target_lf_forward. 
rww lf_vertex_lf_make_comp. sh a; sh s; am. 
rww target_lf_backward. 
rww lf_vertex_lf_make_comp. am. 
rww lf_forward_lf_make_comp. 
rww lf_backward_lf_make_comp. 
Qed. 


Lemma source_lf_comp_rep : forall a s u v,
has_left_fractions a s -> 
is_lf_symbol a s u -> is_lf_symbol a s v ->
source u = target v -> 
source (lf_comp_rep a s u v) = source v.
Proof.
ir.
assert (fills_in a s u v (lf_filler a s u v)).
app fills_in_lf_filler. 

uf lf_comp_rep.  
rww source_lf_make_comp. 
Qed.

Lemma target_lf_comp_rep : forall a s u v,
has_left_fractions a s -> 
is_lf_symbol a s u -> is_lf_symbol a s v ->
source u = target v -> 
target (lf_comp_rep a s u v) = target u.
Proof.
ir.
assert (fills_in a s u v (lf_filler a s u v)).
app fills_in_lf_filler. 

uf lf_comp_rep.  
rww target_lf_make_comp. 
Qed.

Lemma is_lf_symbol_lf_comp_rep : forall a s u v,
has_left_fractions a s -> 
is_lf_symbol a s u -> is_lf_symbol a s v ->
source u = target v -> 
is_lf_symbol a s (lf_comp_rep a s u v).
Proof.
ir.
assert (fills_in a s u v (lf_filler a s u v)).
app fills_in_lf_filler. 

uf lf_comp_rep.
app is_lf_symbol_lf_make_comp.
Qed.

Lemma weakly_reps_lf_comp_lf_comp_rep : forall a s u v,
has_left_fractions a s -> is_lf_symbol a s u ->
is_lf_symbol a s v -> source u = target v ->
weakly_reps_lf_comp a s u v (lf_comp_rep a s u v).
Proof.
ir.
assert (fills_in a s u v (lf_filler a s u v)).
app fills_in_lf_filler. 

uf lf_comp_rep. app weakly_reps_make_comp. 
Qed.
 

Lemma lf_equiv_lf_comp_rep : forall a s u v w,
weakly_reps_lf_comp a s u v w ->
lf_equiv a s w (lf_comp_rep a s u v).
Proof.
ir.
cp H. 
uh H0; ee. 
assert (fills_in a s u v (lf_filler a s u v)).
app fills_in_lf_filler. 

uf lf_comp_rep. app weak_rep_lf_equiv. 
Qed.

Lemma weakly_reps_lf_comp_equiv : forall a s w1 w2,
(exists u, exists v, (weakly_reps_lf_comp a s u v w1 & 
weakly_reps_lf_comp a s u v w2)) ->
lf_equiv a s w1 w2.
Proof.
ir. 
nin H. nin H. ee. 
ap lf_equiv_trans. uh H; ee; am. 
sh (lf_comp_rep a s x x0).
ee. 
ap lf_equiv_lf_comp_rep. am. ap lf_equiv_symm. 
ap lf_equiv_lf_comp_rep. am. 
Qed.


Lemma weakly_reps_make_comp_beyond : forall a s u v u1 v1 y,
has_left_fractions a s -> lf_beyond a s u u1 -> 
lf_beyond a s v v1 -> source u = target v -> 
fills_in a s u1 v1 y -> 
weakly_reps_lf_comp a s u v (lf_make_comp a s u1 v1 y).
Proof.
ir. 
cp H0; cp H1; cp H3. 
uh H4; uh H5; uh H6; ee. 
nin H23; nin H18; ee. 

uhg; ee; try am. 
app is_lf_symbol_lf_make_comp. 
rww source_lf_make_comp. wr H25. 
rww source_lf_extend. 
rww target_lf_make_comp. 
wrr H27. rww target_lf_extend. 

assert (mor a (lf_forward y)).
app mor_lf_forward. sh s; am. 

assert (mor a (lf_backward y)).
ap mor_lf_backward. sh s; am. 

assert (source (lf_forward y) = target x0).
rw source_lf_forward. rw H11. 
wr H25. rww lf_vertex_lf_extend. uh H9; ee; am.

assert (source (lf_backward y) = target x).
rw source_lf_backward. rw H12. wr H27. 
rww lf_vertex_lf_extend. uh H9; ee; am. 

assert (source x0 = target (lf_forward v)).
rww target_lf_forward. sh a; sh s; am. 

assert (source x0 = target (lf_backward v)).
rww target_lf_backward. 

assert (source x = target (lf_forward u)).
rww target_lf_forward. sh a; sh s; am. 

assert (source x = target (lf_backward u)).
rww target_lf_backward. 


sh (comp a (lf_forward y) x0).
sh (comp a (lf_backward y) x).
ee. 

rww mor_comp. rww mor_comp. 
rww source_comp. rww source_comp. 
rww target_comp. rww lf_vertex_lf_make_comp.
rww target_lf_forward. sh a; sh s; am. 
rww target_comp. rww lf_vertex_lf_make_comp.

assert (comp a x0 (lf_backward v) = lf_backward v1).
wr H25. rww lf_backward_lf_extend. 

assert (comp a x (lf_forward u) = lf_forward u1).
wr H27. rww lf_forward_lf_extend. 

rww assoc. rw H36. rww assoc. rww H37. 

ap mor_lf_forward. sh s; am. 
ap mor_lf_backward. sh s; am. 

rww lf_forward_lf_make_comp. 
rww assoc. ap uneq. wr H25. 
rww lf_forward_lf_extend. 
ap mor_lf_forward. sh s; am. 

rww lf_backward_lf_make_comp. 
rww assoc. ap uneq. 
wr H27. 
rww lf_backward_lf_extend. 
ap mor_lf_backward. sh s; am. 
Qed. 

Lemma weakly_reps_comp_rep_beyond : forall a s u v u1 v1,
has_left_fractions a s -> lf_beyond a s u u1 -> 
lf_beyond a s v v1 -> source u = target v -> 
weakly_reps_lf_comp a s u v (lf_comp_rep a s u1 v1).
Proof.
ir.
uf lf_comp_rep. 
app weakly_reps_make_comp_beyond. 
uh H0; uh H1; ee. app fills_in_lf_filler. 
wrr H10. wrr H6. 
Qed. 

(** The following is the statement that equivalent
symbols give equivalent composition representatives
(i.e. well-definedness of the composition up to
equivalence). This was a small piece of a phrase
in GZ. *******************************************)

Lemma lf_comp_indep : forall a s u v u1 v1,
has_left_fractions a s -> lf_equiv a s u u1 ->
lf_equiv a s v v1 -> source u = target v -> 
lf_equiv a s (lf_comp_rep a s u v) (lf_comp_rep a s u1 v1).
Proof.
ir. 
uh H0; uh H1. nin H0; nin H1; ee.
assert (source u = source u1).
uh H0; uh H4. ee. rww H7. 
assert (target v = target v1).
uh H1; uh H3. ee. rww H14. sy; am. 

ap lf_equiv_trans. am. 
sh (lf_comp_rep a s x x0).
ee.

ap weakly_reps_lf_comp_equiv. 
sh u; sh v. ee. app weakly_reps_lf_comp_lf_comp_rep.
uh H0; ee; am. 
uh H1; ee; am. 
app weakly_reps_comp_rep_beyond. 

ap weakly_reps_lf_comp_equiv. 
sh u1; sh v1. ee. 
app weakly_reps_comp_rep_beyond. 
wr H5; wr H6; am. 
app weakly_reps_lf_comp_lf_comp_rep.
uh H4; ee; am. uh H3; ee; am. 
wr H5; wr H6; am. 
Qed. 


(** The following is useful in practice. **)
Lemma lf_equiv_make_comp_comp_rep : forall a s u v y,
fills_in a s u v y ->
lf_equiv a s (lf_make_comp a s u v y) (lf_comp_rep a s u v).
Proof.
ir. ap lf_equiv_lf_comp_rep. 
ap weakly_reps_make_comp. am. 
Qed.

(** Next we do the associativity of composition up to
equivalence. This is relatively easy compared to what
we had to do for transitivity and well-definedness. ***)


(*** The definition [assoc_board]
corresponds to the following
 diagram: it is a sort of diagonal checkerboard. 

  \ w // \ v // \ u //
   \ //   \ //   \ //
      \ y // \ x //
       \ //   \ //
          \ z //
           \ //
 
********************************************)

Definition assoc_board a s u v w x y z :=
fills_in a s u v x &
fills_in a s v w y &
fills_in a s x y z.

(** The combination of [y] and [z]. **)

Definition ffb_symbol a (s:E) y z := 
(lf_symbol (comp a (lf_forward z) (lf_forward y)) (lf_backward z)).

(** The combination of [x] and [z]. **) 

Definition fbb_symbol a (s:E) x z :=
(lf_symbol (lf_forward z) (comp a (lf_backward z) (lf_backward x))).
 
Definition ffb_symbol_facts (a s u v w x y z k:E) := 
lf_forward k = comp a (lf_forward z) (lf_forward y) &
lf_backward k = lf_backward z &
source k = lf_vertex w &
target k = lf_vertex x &
target (lf_forward k) = lf_vertex z &
target (lf_backward k) = lf_vertex z &
lf_symbol_like k &
mor a (lf_forward k) &
mor a (lf_backward k) &
inc (lf_backward k) s &
is_lf_symbol a s k &
fills_in a s (lf_make_comp a s u v x) w k.

Lemma get_ffb_symbol_facts : forall a s u v w x y z,
assoc_board a s u v w x y z -> 
ffb_symbol_facts a s u v w x y z (ffb_symbol a s y z). 
Proof.
ir. 
set (k:= ffb_symbol a s y z).
cp H. uh H0; ee. uh H; ee. 
uh H0; uh H1; uh H2; ee.

assert (mor a (lf_forward z)).
ap mor_lf_forward. sh s; am. 
assert (mor a (lf_forward y)).
ap mor_lf_forward. sh s; am. 
assert (source (lf_forward z) = target (lf_forward y)).
rw source_lf_forward. rw target_lf_forward. 
am. sh a; sh s; am. uh H7; ee; am. 

uhg; dj. 

uf k. uf ffb_symbol. 
rww lf_forward_lf_symbol.

uf k. uf ffb_symbol. 
rww lf_backward_lf_symbol.  

uf k. uf ffb_symbol. 
rw source_lf_symbol. 
rww source_comp. rw source_lf_forward. 
am. uh H6; ee; am. 


uf k; uf ffb_symbol. 
rw target_lf_symbol. rw source_lf_backward. 
am. uh H7; ee; am. 

rw H29. rww target_comp. 
rww target_lf_forward. sh a; sh s; am. 
rw H30. rww target_lf_backward. 
uf k; uf ffb_symbol; ap lf_symbol_like_lf_symbol.

rw H29. rww mor_comp. 
rw H30. ap mor_lf_backward. sh s; am. 
rw H30. ap inc_lf_backward. sh a; am. 


uhg; ee. am. 
uhg; ee. uh H0; ee. 
uh H0; ee; am. 
am. am. rww H34. 

uhg; ee. am. ap is_lf_symbol_lf_make_comp. 
am. am. am. 
rww source_lf_make_comp. am. 
rww lf_vertex_lf_make_comp. 
rw H29. rw H30. 
rw lf_forward_lf_make_comp. 

assert (mor a (lf_backward w)).
ap mor_lf_backward. sh s; am. 

assert (mor a (lf_forward v)).
ap mor_lf_forward. sh s; am. 

assert (mor a (lf_backward y)).
ap mor_lf_backward. sh s; am. 

assert (mor a (lf_forward x)).
ap mor_lf_forward. sh s; am. 

assert (mor a (lf_backward z)).
ap mor_lf_backward. sh s; am. 


assert (source (lf_forward y) = target (lf_backward w)).
rw source_lf_forward. rww target_lf_backward. 
uh H6; ee; am. 

assert (source (lf_backward y) = target (lf_forward v)).
rw source_lf_backward. rww target_lf_forward. 
sh a; sh s; am. uh H6; ee; am. 

assert (source (lf_forward x) = target (lf_forward v)).
rw source_lf_forward. rww target_lf_forward. 
sh a; sh s; am. uh H5; ee; am. 

assert (source (lf_forward z) = target (lf_backward y)).
rw source_lf_forward. rww target_lf_backward. 
uh H7; ee; am. 

assert (source (lf_backward z) = target (lf_forward x)).
rw source_lf_backward. rww target_lf_forward. 
sh a; sh s; am. uh H7; ee; am. 

(** Now for the actual chase! **)

rww assoc. rw H18. 
wrr assoc. rw H11. 
rww assoc. 
Qed. 

Definition fbb_symbol_facts (a s u v w x y z k:E) := 
lf_forward k = lf_forward z &
lf_backward k = comp a (lf_backward z) (lf_backward x) &
source k = lf_vertex y &
target k = lf_vertex u &
target (lf_forward k) = lf_vertex z &
target (lf_backward k) = lf_vertex z &
lf_symbol_like k &
mor a (lf_forward k) &
mor a (lf_backward k) &
inc (lf_backward k) s &
is_lf_symbol a s k &
fills_in a s u (lf_make_comp a s v w y) k.

Lemma get_fbb_symbol_facts : forall a s u v w x y z,
assoc_board a s u v w x y z -> 
fbb_symbol_facts a s u v w x y z (fbb_symbol a s x z).
Proof.
ir. 
cp H. uh H; uh H0. ee. 
uh H0; uh H1; uh H2; ee. 

assert (lf_symbol_like y).
uh H14; ee; am.

assert (lf_symbol_like v).
uh H12; ee; am.

assert (lf_symbol_like z).
uh H7; ee; am.

assert (lf_symbol_like x).
uh H5; ee; am.

assert  (lf_symbol_like u).
uh H19; ee; am.

assert (mor a (lf_forward z)).
ap mor_lf_forward. sh s; am. 

assert (mor a (lf_backward z)).
ap mor_lf_backward. sh s; am. 

assert  (inc (lf_backward z) s).
ap inc_lf_backward. sh a; am. 

assert (mor a (lf_forward x)).
ap mor_lf_forward. sh s; am. 

assert (mor a (lf_backward x)).
ap mor_lf_backward. sh s; am. 

assert (inc (lf_backward x) s).
ap inc_lf_backward. sh a; am. 

assert (mor a (lf_backward y)).
ap mor_lf_backward. sh s; am. 

assert (mor a (lf_backward v)).
ap mor_lf_backward. sh s; am. 

assert (mor a (lf_forward u)).
ap mor_lf_forward. sh s; am. 

assert (source (lf_backward x) = target (lf_forward u)).
rww source_lf_backward. rww target_lf_forward. 
sh a; sh s; am. 

assert (source (lf_forward x) = target (lf_backward v)).
rww source_lf_forward. 

assert (source (lf_backward y) = target (lf_backward v)).
rww source_lf_backward. 

assert (source (lf_backward z) = target (lf_forward x)).
rww source_lf_backward. rww target_lf_forward. 
sh a; sh s; am. 

assert (source (lf_backward z) = target (lf_backward x)).
rww source_lf_backward. 

assert (source (lf_forward z) = target (lf_backward y)).
rww source_lf_forward. 

set (k:= fbb_symbol a s x z). 

uhg; dj. 

uf k. uf fbb_symbol. rww lf_forward_lf_symbol. 

uf k. uf fbb_symbol. rww lf_backward_lf_symbol. 

uf k. uf fbb_symbol. rww source_lf_symbol. 

uf k. uf fbb_symbol. rww target_lf_symbol. 
rww source_comp. rw H40. 
rww target_lf_forward. sh a; sh s; am. 
rw H46. rww target_lf_forward. sh a; sh s; am. 
rw H47. rww target_comp. 
uf k; uf fbb_symbol; ap lf_symbol_like_lf_symbol.
rww H46. rw H47. rww mor_comp. 
rw H47. app inc_comp. uh H0; ee; am. 

uhg; ee. am. uhg; ee. 
uh H0; ee; uh H0; ee; am. am. am. 
rw H50; rww H51. 

uhg; ee. am. am. 
app is_lf_symbol_lf_make_comp. 
am. rww target_lf_make_comp. 
rww lf_vertex_lf_make_comp. am. 

rw lf_backward_lf_make_comp. 
rw H46; rw H47. 

sy. rww assoc. wr H25. 
wrr assoc. wr H11. 
app assoc. 
Qed.  



Lemma make_comp_assoc_board : forall a s u v w x y z,
assoc_board a s u v w x y z ->
lf_make_comp a s (lf_make_comp a s u v x) w (ffb_symbol a s y z) =
lf_make_comp a s u (lf_make_comp a s v w y) (fbb_symbol a s x z).
Proof.
ir. 
cp H. uh H; uh H0. 
ee. uh H0; uh H1; uh H2; ee. 


assert (mor a (lf_forward w)).
ap mor_lf_forward. sh s; am. 

assert (mor a (lf_forward y)).
ap mor_lf_forward. sh s; am. 

assert (mor a (lf_forward z)).
ap mor_lf_forward. sh s; am. 

assert (mor a (lf_backward u)).
ap mor_lf_backward. sh s; am. 

assert (mor a (lf_backward x)).
ap mor_lf_backward. sh s; am. 

assert (mor a (lf_backward z)).
ap mor_lf_backward. sh s; am. 

assert (source (lf_forward y) = target (lf_forward w)).
rw source_lf_forward. rww target_lf_forward.
sh a; sh s; am. uh H6; ee; am. 

assert (source (lf_forward z) = target (lf_forward y)).
rw source_lf_forward. rww target_lf_forward.
sh a; sh s; am. uh H7; ee; am. 

assert (source (lf_backward x) = target (lf_backward u)).
rww source_lf_backward. uh H5; ee; am. 

assert (source (lf_backward z) = target (lf_backward x)). 
rww source_lf_backward. uh H7; ee; am. 


ap lf_symbol_like_extens. 
uf lf_make_comp. ap lf_symbol_like_lf_symbol. 
uf lf_make_comp. ap lf_symbol_like_lf_symbol. 

rw lf_forward_lf_make_comp. 
uf ffb_symbol. rw lf_forward_lf_symbol. 
rw lf_forward_lf_make_comp. 
uf fbb_symbol; rw lf_forward_lf_symbol. 
rw lf_forward_lf_make_comp. 
app assoc. 



rw lf_backward_lf_make_comp. 
uf ffb_symbol. rw lf_backward_lf_symbol. 
rw lf_backward_lf_make_comp. 
rw lf_backward_lf_make_comp. 
uf fbb_symbol; rw lf_backward_lf_symbol. 
sy; app assoc. 
Qed.

Lemma lf_comp_rep_assoc : forall a s u v w,
has_left_fractions a s -> 
is_lf_symbol a s u -> is_lf_symbol a s v -> 
is_lf_symbol a s w -> 
source u = target v -> source v = target w ->
lf_equiv a s (lf_comp_rep a s (lf_comp_rep a s u v) w)
(lf_comp_rep a s u (lf_comp_rep a s v w)).
Proof.
ir. 
set (x:= lf_filler a s u v).
set (y:= lf_filler a s v w).
set (z:= lf_filler a s x y).

assert (assoc_board a s u v w x y z).
uhg; dj. 
uf x. app fills_in_lf_filler. 
uf y. app fills_in_lf_filler. 
uh H5; uh H6; ee. 
uf z. app fills_in_lf_filler. 
rww H12. 

cp H5. uh H6; ee. 
cp (get_ffb_symbol_facts H5). 
cp (get_fbb_symbol_facts H5).

cp (make_comp_assoc_board H5). 
generalize H9 H10 H11. clear H9 H10 H11. 
set (k:= ffb_symbol a s y z). 
set (l:= fbb_symbol a s x z). 
ir. 

uh H9; uh H10; ee.

assert (lf_make_comp a s v w y = lf_comp_rep a s v w).
reflexivity. 

assert (lf_make_comp a s u v x = lf_comp_rep a s u v).
reflexivity. 

rwi H34 H22. 
rwi H35 H33. rwi H34 H11. rwi H35 H11. 

cp (lf_equiv_make_comp_comp_rep H33). 
cp (lf_equiv_make_comp_comp_rep H22). 

ap lf_equiv_trans. 
am. sh (lf_make_comp a s (lf_comp_rep a s u v) w k).
ee.

app lf_equiv_symm. 
rww H11.  
Qed. 

Definition left_id_filler a (s:E) u := 
lf_symbol (id a (lf_vertex u)) (lf_backward u).

Definition right_id_filler a (s:E) u :=
lf_symbol (lf_forward u) (id a (lf_vertex u)).

Lemma ob_lf_vertex : forall a u,
(exists s,(is_lf_symbol a s u)) ->
ob a (lf_vertex u).
Proof.
ir. uf lf_vertex. rww ob_target. 
app mor_lf_backward. 
Qed. 

Lemma source_left_id_filler : forall a s u,
is_lf_symbol a s u -> 
source (left_id_filler a s u) = lf_vertex u.
Proof.
ir. uf left_id_filler. rw source_lf_symbol. 
rww source_id. 
ap ob_lf_vertex. sh s; am. 
Qed.

Lemma target_left_id_filler : forall a s u,
is_lf_symbol a s u -> 
target (left_id_filler a s u) = target u.
Proof.
ir. uf left_id_filler. rw target_lf_symbol. 
rw source_lf_backward. tv. uh H; ee; am. 
Qed.

Lemma source_right_id_filler : forall a s u,
is_lf_symbol a s u -> 
source (right_id_filler a s u) = source u.
Proof.
ir. uf right_id_filler. rw source_lf_symbol. 
rw source_lf_forward. tv. uh H; ee; am.   
Qed.

Lemma target_right_id_filler : forall a s u,
is_lf_symbol a s u -> 
target (right_id_filler a s u) = lf_vertex u.
Proof.
ir. uf right_id_filler. rw target_lf_symbol. 
uf lf_vertex. ap source_id. 
rww ob_target. ap mor_lf_backward. sh s; am. 
Qed.

Lemma lf_forward_left_id_filler : forall a s u,
is_lf_symbol a s u -> 
lf_forward (left_id_filler a s u) = id a (lf_vertex u).
Proof.
ir. uf left_id_filler. rww lf_forward_lf_symbol. 
Qed. 

Lemma lf_backward_left_id_filler : forall a s u,
is_lf_symbol a s u -> 
lf_backward (left_id_filler a s u) = lf_backward u.
Proof.
ir. uf left_id_filler. rww lf_backward_lf_symbol. 
Qed. 

Lemma lf_forward_right_id_filler : forall a s u,
is_lf_symbol a s u -> 
lf_forward (right_id_filler a s u) = lf_forward u.
Proof.
ir. uf right_id_filler. rww lf_forward_lf_symbol. 
Qed. 

Lemma lf_backward_right_id_filler : forall a s u,
is_lf_symbol a s u -> 
lf_backward (right_id_filler a s u) = id a (lf_vertex u).
Proof.
ir. uf right_id_filler. rww lf_backward_lf_symbol. 
Qed. 

Lemma lf_vertex_left_id_filler : forall a s u,
is_lf_symbol a s u -> 
lf_vertex (left_id_filler a s u) = lf_vertex u.
Proof.
ir. uf lf_vertex. 
rww lf_backward_left_id_filler. 
Qed.

Lemma lf_vertex_right_id_filler : forall a s u,
is_lf_symbol a s u -> 
lf_vertex (right_id_filler a s u) = lf_vertex u.
Proof.
ir. uf lf_vertex.   
rww lf_backward_right_id_filler. 
rww target_id. 
ap ob_lf_vertex. sh s; am.  
Qed.

Lemma is_lf_symbol_left_id_filler : forall a s u,
is_lf_symbol a s u -> 
is_lf_symbol a s (left_id_filler a s u).
Proof.
ir. uhg; ee. 
uf left_id_filler. ap lf_symbol_like_lf_symbol. 
uhg; ee. 
lu. rww lf_forward_left_id_filler. 
app mor_id. 
ap ob_lf_vertex. sh s; am. 
rw lf_backward_left_id_filler. 
ap inc_lf_backward. sh a; am. 
am. 
rww lf_forward_left_id_filler. 
rww lf_backward_left_id_filler. 
rww target_id. ap ob_lf_vertex. sh s; am.  
Qed.


Lemma is_lf_symbol_right_id_filler : forall a s u,
has_left_fractions a s -> is_lf_symbol a s u -> 
is_lf_symbol a s (right_id_filler a s u).
Proof.
ir. uhg; ee. 
uf right_id_filler. ap lf_symbol_like_lf_symbol. 
uhg; ee. 
lu. rww lf_forward_right_id_filler. 
ap mor_lf_forward. sh s; am. 
rw lf_backward_right_id_filler. 
uh H; ee. ap H1. ap ob_lf_vertex. sh s; am. am. 

rww lf_forward_right_id_filler. 
rww lf_backward_right_id_filler. 
rww target_id. rww target_lf_forward. 
sh a; sh s; am. ap ob_lf_vertex. sh s; am.  
Qed.


Lemma lf_forward_lf_id_rep : forall a x,
lf_forward (lf_id_rep a x) = id a x.
Proof.
ir. uf lf_id_rep. rww lf_forward_lf_symbol. 
Qed.

Lemma lf_backward_lf_id_rep : forall a x,
lf_backward (lf_id_rep a x) = id a x.
Proof.
ir. uf lf_id_rep. rww lf_backward_lf_symbol. 
Qed.


Lemma fills_in_left_id_filler : forall a s u,
has_left_fractions a s -> is_lf_symbol a s u ->
fills_in a s (lf_id_rep a (target u)) u (left_id_filler a s u).
Proof.
ir. 
assert (target u = source (lf_backward u)).
rww source_lf_backward. uh H0; ee; am. 
assert (ob a (target u)).
rw H1. rww ob_source. ap mor_lf_backward. 
sh s; am. 

assert (mor a (lf_backward u)).
ap mor_lf_backward. sh s; am. 


uhg; ee. 
am. ap is_lf_symbol_lf_id_rep. am. 
am. am. 
ap is_lf_symbol_left_id_filler. am. 
rww source_lf_id_rep. 
rww source_left_id_filler. 
rww target_left_id_filler. 
uf lf_vertex. 
rw lf_backward_lf_id_rep. 
rww target_id. 

rww lf_forward_left_id_filler. rw lf_backward_left_id_filler.
rw lf_forward_lf_id_rep. 
assert (lf_vertex u = target (lf_backward u)).
tv. rw H4. 
rww left_id. 
rw H1. 
rww right_id. rww ob_source. 
rww ob_target. am.  
Qed.

Lemma fills_in_right_id_filler : forall a s u,
has_left_fractions a s -> is_lf_symbol a s u ->
fills_in a s u (lf_id_rep a (source u)) (right_id_filler a s u).
Proof.
ir. 
assert (source u = source (lf_forward u)).
rww source_lf_forward. uh H0; ee; am. 
assert (ob a (source u)).
rw H1. rww ob_source. ap mor_lf_forward. 
sh s; am. 

assert (mor a (lf_forward u)).
ap mor_lf_forward. sh s; am. 


uhg; ee. 
am. am. ap is_lf_symbol_lf_id_rep. am. 
am. 
ap is_lf_symbol_right_id_filler. am. 
am. rww target_lf_id_rep. 
rww source_right_id_filler. 
uf lf_vertex. 
rw lf_backward_lf_id_rep. 
rww target_id. 

rww target_right_id_filler. 

rww lf_forward_right_id_filler. rw lf_backward_right_id_filler.
rw lf_backward_lf_id_rep. 
assert (lf_vertex u = target (lf_forward u)).
rw target_lf_forward. tv. sh a; sh s; am.  rw H4. 
rww right_id. 
rww left_id. rww ob_target. 
rww source_lf_forward. uh H0; ee; am. am. 
Qed.

Lemma lf_make_comp_left_id_filler : forall a s u,
is_lf_symbol a s u -> 
lf_make_comp a s (lf_id_rep a (target u)) u 
(left_id_filler a s u) = u.
Proof.
ir. 

ap lf_symbol_like_extens. 
uf lf_make_comp. ap lf_symbol_like_lf_symbol. 
uh H; ee; am. 
rw lf_forward_lf_make_comp. 
rw lf_forward_left_id_filler. 
assert (lf_vertex u = target (lf_forward u)).
rw target_lf_forward. tv. sh a; sh s; am. 
rw H0. 
rww left_id. rww ob_target. 
ap mor_lf_forward. sh s; am. 
ap mor_lf_forward. sh s; am. am. 

rw lf_backward_lf_make_comp. 
rw lf_backward_left_id_filler. 
rw lf_backward_lf_id_rep. 
assert (target u = source (lf_backward u)).
rww source_lf_backward. uh H; ee; am. 
rw H0. rww right_id. 
rww ob_source. 
ap mor_lf_backward. sh s; am. 
ap mor_lf_backward. sh s; am. am. 
Qed.

Lemma lf_make_comp_right_id_filler : forall a s u,
is_lf_symbol a s u -> 
lf_make_comp a s u (lf_id_rep a (source u)) 
(right_id_filler a s u) = u.
Proof.
ir. 
assert (mor a (lf_forward u)).
ap mor_lf_forward. sh s; am.

assert (mor a (lf_backward u)).
ap mor_lf_backward. sh s; am.

ap lf_symbol_like_extens. 
uf lf_make_comp. ap lf_symbol_like_lf_symbol. 
uh H; ee; am. 

rw lf_forward_lf_make_comp. 
rw lf_forward_right_id_filler. 
rw lf_forward_lf_id_rep. 
assert (source u = source (lf_forward u)).
rww source_lf_forward. uh H; ee; am. 
rw H2. 
rww right_id. rww ob_source. am. 

rw lf_backward_lf_make_comp. 
rw lf_backward_right_id_filler. 
assert (lf_vertex u = target (lf_backward u)).
rww target_lf_backward. rw H2. 
rww left_id. rww ob_target. am. 
Qed.

(** putting together the above with previous stuff
we get the left and right identity properties **)

Lemma lf_left_id : forall a s u,
has_left_fractions a s ->
is_lf_symbol a s u -> 
lf_equiv a s (lf_comp_rep a s (lf_id_rep a (target u)) u) u.
Proof.
ir. 
cp (fills_in_left_id_filler H H0). 
cp (lf_equiv_make_comp_comp_rep H1).
rwi lf_make_comp_left_id_filler H2. 
app lf_equiv_symm. am. 
Qed.

Lemma lf_right_id : forall a s u,
has_left_fractions a s ->
is_lf_symbol a s u -> 
lf_equiv a s (lf_comp_rep a s u (lf_id_rep a (source u))) u.
Proof.
ir. 
cp (fills_in_right_id_filler H H0). 
cp (lf_equiv_make_comp_comp_rep H1).
rwi lf_make_comp_right_id_filler H2. 
app lf_equiv_symm. am. 
Qed.

(** Now we define the [taut_lf_symbol]'s which will 
give the functor from [a] to the fraction category. **) 


Definition taut_lf_symbol a y :=
lf_symbol y (id a (target y)).


Lemma source_taut_lf_symbol : forall a y,
source (taut_lf_symbol a y) = source y.
Proof.
ir. uf taut_lf_symbol. rww source_lf_symbol.
Qed.

Lemma target_taut_lf_symbol : forall a y,
mor a y -> 
target (taut_lf_symbol a y) = target y.
Proof.
ir. uf taut_lf_symbol. rww target_lf_symbol.
rww source_id. rww ob_target. 
Qed.

Lemma lf_forward_taut_lf_symbol : forall a y,
lf_forward (taut_lf_symbol a y) = y.
Proof.
ir. uf taut_lf_symbol. 
rww lf_forward_lf_symbol. 
Qed.

Lemma lf_backward_taut_lf_symbol : forall a y,
lf_backward (taut_lf_symbol a y) = id a (target y).
Proof.
ir. uf taut_lf_symbol. 
rww lf_backward_lf_symbol. 
Qed.

Lemma lf_vertex_taut_lf_symbol : forall a y,
mor a y -> 
lf_vertex (taut_lf_symbol a y) = target y.
Proof.
ir. uf lf_vertex. rw lf_backward_taut_lf_symbol.
rww target_id. rww ob_target. 
Qed.

Lemma is_lf_symbol_taut_lf_symbol : forall a s y,
has_left_fractions a s -> mor a y ->
is_lf_symbol a s (taut_lf_symbol a y).
Proof.
ir. 
uhg; ee. uf taut_lf_symbol. 
ap lf_symbol_like_lf_symbol. 
uhg; ee. 
lu. 
rww lf_forward_taut_lf_symbol. 
rww lf_backward_taut_lf_symbol. 
uh H; ee.
ap H1. rww ob_target. 
rw lf_forward_taut_lf_symbol. 
rw lf_backward_taut_lf_symbol. 
rww target_id. rww ob_target. 
Qed.

Lemma taut_lf_symbol_id : forall a x,
ob a x -> 
taut_lf_symbol a (id a x) = lf_id_rep a x.
Proof.
ir. uf taut_lf_symbol. 
rww target_id. 
Qed. 

Lemma fills_in_taut_lf_symbol : forall a s y z,
has_left_fractions a s -> 
mor a y -> mor a z -> source y = target z ->
fills_in a s (taut_lf_symbol a y) 
(taut_lf_symbol a z) (taut_lf_symbol a y).
Proof.
ir. 

uhg; ee. 
am. 
app is_lf_symbol_taut_lf_symbol. 
app is_lf_symbol_taut_lf_symbol. 
app is_lf_symbol_taut_lf_symbol. 
rww source_taut_lf_symbol. 
rww target_taut_lf_symbol. 
rww source_taut_lf_symbol. 
rww lf_vertex_taut_lf_symbol. 
rww target_taut_lf_symbol. 
rww lf_vertex_taut_lf_symbol. 

rww lf_forward_taut_lf_symbol. 
rww lf_backward_taut_lf_symbol. 
rww lf_backward_taut_lf_symbol. 
wr H2. rww left_id. rww right_id. 
rww ob_source. rww ob_target. 
Qed.

Lemma comp_taut_lf_symbol : forall a s y z,
has_left_fractions a s -> 
mor a y -> mor a z -> source y = target z ->
lf_equiv a s 
(lf_comp_rep a s (taut_lf_symbol a y) (taut_lf_symbol a z))
(taut_lf_symbol a (comp a y z)).
Proof.
ir. 
cp (fills_in_taut_lf_symbol H H0 H1 H2). 
cp (lf_equiv_make_comp_comp_rep H3).

assert (lf_make_comp a s (taut_lf_symbol a y) (taut_lf_symbol a z)
          (taut_lf_symbol a y) = taut_lf_symbol a (comp a y z)).
ap lf_symbol_like_extens. 
uf lf_make_comp. ap lf_symbol_like_lf_symbol. 
uf taut_lf_symbol. ap lf_symbol_like_lf_symbol. 

rww lf_forward_lf_make_comp. 
rww lf_forward_taut_lf_symbol. 
rww lf_forward_taut_lf_symbol. 
rww lf_forward_taut_lf_symbol. 

rww lf_backward_lf_make_comp. 
rww lf_backward_taut_lf_symbol. 
rww lf_backward_taut_lf_symbol. 
rww left_id. 
rww target_comp. rww ob_target. app mor_id. 
rww ob_target. rww target_id. 
rww ob_target. 

rwi H5 H4. app lf_equiv_symm. 
Qed.

 

(** Next are the inverses for morphisms in [s]. **)

Definition inverse_lf_symbol a y :=
lf_symbol (id a (target y)) y.

Lemma source_inverse_lf_symbol : forall a y,
mor a y -> 
source (inverse_lf_symbol a y) = target y.
Proof.
ir. uf inverse_lf_symbol. rww source_lf_symbol.
rww source_id. rww ob_target. 
Qed.

Lemma target_inverse_lf_symbol : forall a y,
mor a y -> 
target (inverse_lf_symbol a y) = source y.
Proof.
ir. uf inverse_lf_symbol. rww target_lf_symbol.
Qed.

Lemma lf_forward_inverse_lf_symbol : forall a y,
lf_forward (inverse_lf_symbol a y) = id a (target y).
Proof.
ir. uf inverse_lf_symbol. 
rww lf_forward_lf_symbol. 
Qed.

Lemma lf_backward_inverse_lf_symbol : forall a y,
lf_backward (inverse_lf_symbol a y) = y.
Proof.
ir. uf inverse_lf_symbol. 
rww lf_backward_lf_symbol. 
Qed.

Lemma lf_vertex_inverse_lf_symbol : forall a y,
lf_vertex (inverse_lf_symbol a y) = target y.
Proof.
ir. uf lf_vertex. rw lf_backward_inverse_lf_symbol.
tv. 
Qed.

Lemma is_lf_symbol_inverse_lf_symbol : forall a s y,
has_left_fractions a s -> inc y s ->
is_lf_symbol a s (inverse_lf_symbol a y).
Proof.
ir. 
assert (mor a y).
ap inc_hlf_mor. sh s; ee; am. 
uhg; ee. uf inverse_lf_symbol. 
ap lf_symbol_like_lf_symbol. 
uhg; ee. 
lu. 
rww lf_forward_inverse_lf_symbol. 
app mor_id. rww ob_target. 
rww lf_backward_inverse_lf_symbol. 
rw lf_forward_inverse_lf_symbol. 
rw lf_backward_inverse_lf_symbol. 
rww target_id. rww ob_target. 
Qed.

Lemma fills_in_left_lf_inverse : forall a s y,
has_left_fractions a s -> inc y s ->
fills_in a s (inverse_lf_symbol a y) (taut_lf_symbol a y)
(lf_id_rep a (target y)).
Proof.
ir. 
assert (mor a y).
ap inc_hlf_mor. sh s; ee; am. 
assert (ob a (source y)).
rww ob_source. 
assert (ob a (target y)).
rww ob_target. 

uhg; ee. am. 
app is_lf_symbol_inverse_lf_symbol. 
app is_lf_symbol_taut_lf_symbol. 
app is_lf_symbol_lf_id_rep. 

rww source_inverse_lf_symbol. rww target_taut_lf_symbol.
rww source_lf_id_rep. rww lf_vertex_taut_lf_symbol. 
rww target_lf_id_rep. rww lf_vertex_inverse_lf_symbol. 

rww lf_forward_lf_id_rep. 
rww lf_backward_taut_lf_symbol. 
rww lf_backward_lf_id_rep. 
rww lf_forward_inverse_lf_symbol. 
Qed.

Lemma fills_in_right_lf_inverse : forall a s y,
has_left_fractions a s -> inc y s ->
fills_in a s (taut_lf_symbol a y) (inverse_lf_symbol a y)
(lf_id_rep a (target y)).
Proof.
ir. 
assert (mor a y).
ap inc_hlf_mor. sh s; ee; am. 
assert (ob a (source y)).
rww ob_source. 
assert (ob a (target y)).
rww ob_target. 

uhg; ee. am. 
app is_lf_symbol_taut_lf_symbol. 
app is_lf_symbol_inverse_lf_symbol. 
app is_lf_symbol_lf_id_rep. 

rww target_inverse_lf_symbol. rww source_taut_lf_symbol.
rww source_lf_id_rep. rww lf_vertex_inverse_lf_symbol. 
rww target_lf_id_rep. rww lf_vertex_taut_lf_symbol. 

rww lf_forward_lf_id_rep. 
rww lf_backward_inverse_lf_symbol. 
rww lf_backward_lf_id_rep. 
rww lf_forward_taut_lf_symbol. 
Qed.


Lemma lf_left_inverse : forall a s y,
has_left_fractions a s -> inc y s ->
lf_equiv a s 
(lf_comp_rep a s (inverse_lf_symbol a y) (taut_lf_symbol a y))
(lf_id_rep a (source y)).
Proof.
ir. 
assert (mor a y).
ap inc_hlf_mor. sh s; ee; am. 
assert (ob a (source y)).
rww ob_source. 
assert (ob a (target y)).
rww ob_target. 

cp (fills_in_left_lf_inverse H H0). 
cp (lf_equiv_make_comp_comp_rep H4).
assert (lf_make_comp a s 
(inverse_lf_symbol a y) (taut_lf_symbol a y)
(lf_id_rep a (target y)) = lf_symbol y y).
ap lf_symbol_like_extens. 
uf lf_make_comp. ap lf_symbol_like_lf_symbol.
ap lf_symbol_like_lf_symbol.

rww lf_forward_lf_make_comp. 
rww lf_forward_lf_id_rep. 
rww lf_forward_taut_lf_symbol. 
rww lf_forward_lf_symbol. 
rww left_id. 

rww lf_backward_lf_make_comp. 
rww lf_backward_lf_id_rep. 
rww lf_backward_inverse_lf_symbol. 
rww lf_backward_lf_symbol. 
rww left_id. 

rwi H6 H5. 
clear H6. 

apply lf_equiv_trans. am. 
sh (lf_symbol y y). 
ee. 
app lf_equiv_symm. 

assert (is_lf_symbol a s (lf_symbol y y)).
uhg; ee. ap lf_symbol_like_lf_symbol. 
uhg; ee. uh H; ee; uh H; ee; am. 
rww lf_forward_lf_symbol. 
rww lf_backward_lf_symbol. 
rww lf_forward_lf_symbol. 
rww lf_backward_lf_symbol. 

uhg; ee. 

sh (lf_symbol y y).
ee. 
ap lf_beyond_refl. am. am. 

uhg; ee. 
am. app is_lf_symbol_lf_id_rep. 
am. 
rww source_lf_id_rep. rww source_lf_symbol. 
rww target_lf_id_rep. rww target_lf_symbol.
sh y. ee. am. 
uf lf_vertex. rww lf_backward_lf_id_rep. 
rww target_id. 
uf lf_extend. 
rw lf_forward_lf_id_rep. 
rw right_id. 
rw lf_backward_lf_id_rep. 
rw right_id. tv. am. am. tv. tv. 
am. am. tv. tv. 
Qed.


Lemma lf_right_inverse : forall a s y,
has_left_fractions a s -> inc y s ->
lf_equiv a s 
(lf_comp_rep a s (taut_lf_symbol a y) (inverse_lf_symbol a y))
(lf_id_rep a (target y)).
Proof.
ir. 
assert (mor a y).
ap inc_hlf_mor. sh s; ee; am. 
assert (ob a (source y)).
rww ob_source. 
assert (ob a (target y)).
rww ob_target. 

cp (fills_in_right_lf_inverse H H0). 
cp (lf_equiv_make_comp_comp_rep H4).
assert (lf_make_comp a s 
(taut_lf_symbol a y) (inverse_lf_symbol a y)
(lf_id_rep a (target y)) = lf_id_rep a (target y)).
ap lf_symbol_like_extens. 
uf lf_make_comp. ap lf_symbol_like_lf_symbol.
uf lf_id_rep. ap lf_symbol_like_lf_symbol.

rww lf_forward_lf_make_comp. 
rww lf_forward_lf_id_rep. 
rww lf_forward_inverse_lf_symbol. 
rww left_id. app mor_id. 
rww target_id. 

rww lf_backward_lf_make_comp. 
rww lf_backward_lf_id_rep. 
rww lf_backward_taut_lf_symbol. 
rww left_id. 
app mor_id. rww target_id. 

rwi H6 H5. app lf_equiv_symm. 
Qed.

Lemma lf_symbol_equiv : forall a s u,
has_left_fractions a s -> is_lf_symbol a s u ->
lf_equiv a s u 
(lf_comp_rep a s 
(inverse_lf_symbol a (lf_backward u))
(taut_lf_symbol a (lf_forward u))).
Proof.
ir. 
assert (exists s0, is_lf_symbol a s0 u).
sh s; am. 
assert (exists a0, is_lf_symbol a0 s u).
sh a; am. 
assert (exists a0, exists s0, is_lf_symbol a0 s0 u).
sh a; sh s; am. 
assert (mor a (lf_forward u)).
app mor_lf_forward. 
assert (mor a (lf_backward u)).
app mor_lf_backward. 
assert (inc (lf_backward u) s).
app inc_lf_backward. 
assert (ob a (lf_vertex u)).
app ob_lf_vertex.  


assert (fills_in a s (inverse_lf_symbol a (lf_backward u))
(taut_lf_symbol a (lf_forward u)) (lf_id_rep a (lf_vertex u))).

uhg; ee. am. 
app is_lf_symbol_inverse_lf_symbol. 
app is_lf_symbol_taut_lf_symbol. 
app is_lf_symbol_lf_id_rep. 

rww source_inverse_lf_symbol. 
rww target_taut_lf_symbol. rww target_lf_forward. 
rww source_lf_id_rep. rww lf_vertex_taut_lf_symbol. 
rww target_lf_forward. 
rww target_lf_id_rep. rww lf_vertex_inverse_lf_symbol.

rww lf_forward_lf_id_rep. 
rww lf_backward_taut_lf_symbol. rww target_lf_forward.
rww lf_backward_lf_id_rep. rww lf_forward_inverse_lf_symbol.

cp (lf_equiv_make_comp_comp_rep H8). 

assert (lf_make_comp a s (inverse_lf_symbol a (lf_backward u))
(taut_lf_symbol a (lf_forward u)) (lf_id_rep a (lf_vertex u)) = u).
ap lf_symbol_like_extens. 
uf lf_make_comp. ap lf_symbol_like_lf_symbol. 
uh H0; ee. am. 

rww lf_forward_lf_make_comp. 
rww lf_forward_lf_id_rep. 
rww lf_forward_taut_lf_symbol. 
assert (lf_vertex u = target (lf_forward u)). 
rww target_lf_forward. rw H10. app left_id. 
rww ob_target. 

rww lf_backward_lf_make_comp. rww lf_backward_lf_id_rep.
rww lf_backward_inverse_lf_symbol. 
assert  (lf_vertex u = target (lf_backward u)).
tv. rw H10. rww left_id. 

rwi H10 H9. am. 
Qed.


End Left_Fractions.

(** Now we combine everything together to define
the quotient by lf_equiv which is our category of
left fractions. ***)

Module Left_Fraction_Category.
Export Left_Fractions.
Export Associating_Quotient.

Definition lf_symbol_container a s :=
Image.create (Cartesian.product (morphisms a) s)
(fun z => lf_symbol (pr1 z) (pr2 z)).

Lemma inc_lf_symbol_container : forall a s u,
is_lf_symbol a s u -> 
inc u (lf_symbol_container a s).
Proof.
ir. 
uf lf_symbol_container. 
rw Image.inc_rw. 
sh (pair (lf_forward u) (lf_backward u)). 
ee. 
ap product_pair_inc. 
change (is_mor a (lf_forward u)).
ap mor_is_mor. ap mor_lf_forward. 
sh s; am. ap inc_lf_backward. 
sh a; am. 
rw pr1_pair. rw pr2_pair. 
uh H; ee. uh H; ee. sy; am. 
Qed. 

Definition lf_symbol_set a s :=
Z (lf_symbol_container a s) (is_lf_symbol a s).

Lemma inc_lf_symbol_set : forall a s u,
inc u (lf_symbol_set a s) = is_lf_symbol a s u.
Proof.
ir. 
uf lf_symbol_set. 
ap iff_eq; ir. 
Ztac. Ztac. app inc_lf_symbol_container. 
Qed. 

Definition lfc_rqcat a s :=
Category.Notations.create (objects a)
(lf_symbol_set a s) (lf_comp_rep a s) (lf_id_rep a) (structure a).

Lemma is_ob_lfc_rqcat : forall a s x,
has_left_fractions a s -> 
is_ob (lfc_rqcat a s) x = ob a x.
Proof.
ir. uf lfc_rqcat. 
rw is_ob_create. 
ap iff_eq; ir. ap is_ob_ob. lu. am. 
ap ob_is_ob. am. 
Qed.

Lemma is_mor_lfc_rqcat : forall a s u,
has_left_fractions a s -> 
is_mor (lfc_rqcat a s) u = is_lf_symbol a s u.
Proof.
ir. 
uf lfc_rqcat. rw is_mor_create. 
rww inc_lf_symbol_set. 
Qed.

Lemma comp_lfc_rqcat : forall a s u v,
has_left_fractions a s -> 
is_lf_symbol a s u -> 
is_lf_symbol a s v ->
source u = target v -> 
comp (lfc_rqcat a s) u v = lf_comp_rep a s u v.
Proof.
ir. 
uf lfc_rqcat. 
rw comp_create. tv. rww inc_lf_symbol_set. 
rww inc_lf_symbol_set. am. 
Qed.

Lemma id_lfc_rqcat : forall a s x,
has_left_fractions a s -> ob a x ->
id (lfc_rqcat a s) x = lf_id_rep a x.
Proof.
ir. uf lfc_rqcat. 
rw id_create. tv. app ob_is_ob. 
Qed.


Lemma rqcat_lfc_rqcat : forall a s,
has_left_fractions a s -> 
rqcat (lfc_rqcat a s).
Proof.
ir. uhg; ee.
uf lfc_rqcat. 
ap create_like. 
ir. rwi is_mor_lfc_rqcat H0. 
uh H0; ee. 
uh H0; ee. rw H0. 
uf lf_symbol. rww Arrow.create_like. 
am. 

ir. 
rwi is_ob_lfc_rqcat H0. rww is_mor_lfc_rqcat. rww id_lfc_rqcat. 
app is_lf_symbol_lf_id_rep. 
am. 

ir. 
rwi is_ob_lfc_rqcat H0. 
rww id_lfc_rqcat. rww source_lf_id_rep. 
am. 

ir. 
rwi is_ob_lfc_rqcat H0. 
rww id_lfc_rqcat. rww target_lf_id_rep. 
am. 

ir. 
rwi is_mor_lfc_rqcat H0. 
rww is_ob_lfc_rqcat. 
assert (source u = source (lf_forward u)).
rww source_lf_forward. uh H0; ee; am. 
rw H1. rww ob_source. 
ap mor_lf_forward. sh s; am. am. 

ir. 
rwi is_mor_lfc_rqcat H0. 
rww is_ob_lfc_rqcat. 
assert (target u = source (lf_backward u)).
rww source_lf_backward. uh H0; ee; am. 
rw H1. rww ob_source. 
ap mor_lf_backward. sh s; am. am. 

ir. 
rwi is_mor_lfc_rqcat H0. 
rwi is_mor_lfc_rqcat H1. 
rww  is_mor_lfc_rqcat. 
rww comp_lfc_rqcat. 
app is_lf_symbol_lf_comp_rep. am. am. 


ir. 
rwi is_mor_lfc_rqcat H0. 
rwi is_mor_lfc_rqcat H1. 
rww comp_lfc_rqcat. rww source_lf_comp_rep.
am. am. 

ir. 
rwi is_mor_lfc_rqcat H0. 
rwi is_mor_lfc_rqcat H1. 
rww comp_lfc_rqcat. rww target_lf_comp_rep.
am. am. 
Qed. 


Definition lfer a s :=
Z (Cartesian.product (lf_symbol_set a s) (lf_symbol_set a s))
(fun z => lf_equiv a s (pr1 z) (pr2 z)).

Lemma related_lfer : forall a s u v,
has_left_fractions a s -> 
related (lfer a s) u v = lf_equiv a s u v.
Proof.
ir. 
ap iff_eq; ir. 
ufi lfer H0.
uh H0. 
cp (Z_pr H0). 
cbv beta in H1. rwi pr1_pair H1. rwi pr2_pair H1. am. 

uhg. uf lfer. 
ap Z_inc. ap product_pair_inc. 
rw inc_lf_symbol_set. uh H0; ee. 
nin H0. ee. uh H0; ee. am. 
uh H0. nin H0. ee. 
rww inc_lf_symbol_set. uh H1; ee; am. 
rw pr1_pair. rw pr2_pair. am. 
Qed.

Lemma related_lfer_rw : forall a s u v,
has_left_fractions a s ->
related (lfer a s) u v =
(is_lf_symbol a s u & is_lf_symbol a s v &
source u = source v & target u = target v & 
lf_equiv a s u v).
Proof.
ir. ap iff_eq; ir. rwi related_lfer H0.
uh H0. nin H0. ee. 
uh H0; ee; am. uh H1; ee; am. 
uh H0; uh H1; ee. rw H9. sy; am. 
uh H0; uh H1; ee.
rww H5. uhg. sh x; ee; am. am. 
rw related_lfer. ee; am. am. 
Qed. 

Lemma inc_lfer : forall a s x,
has_left_fractions a s -> 
inc x (lfer a s) = 
(is_pair x & (related (lfer a s) (pr1 x) (pr2 x))).
Proof.
ir. ap iff_eq; ir. 
ee. ufi lfer H0. Ztac. 
cp (product_pr H1). ee; am. 
ufi lfer H0. Ztac. 
cp (product_pr H1). ee. 
rw related_lfer. am. am. 
ee. 
uf lfer. ap Z_inc. 
ap product_inc. am. 
rwi related_lfer H1. 
rw inc_lf_symbol_set. uh H1.
nin H1. ee. uh H1; ee; am. am. 
rwi related_lfer H1. 
rw inc_lf_symbol_set. uh H1.
nin H1. ee. uh H2; ee; am. am. 
rwi related_lfer H1. 
am. am. 
Qed. 

Lemma lf_equiv_properties : forall a s u v,
lf_equiv a s u v -> 
(lf_equiv a s u v &
is_lf_symbol a s u & is_lf_symbol a s v &
ob a (source u) & ob a (target u) &
ob a (source v) & ob a (target v) &
source u = source v & target u = target v).
Proof.
ir. dj. 
am. uh H. nin H. ee. uh H; ee; am. 
uh H. nin H. ee. uh H2; ee; am. 
assert (source u = source (lf_forward u)).
rw source_lf_forward. tv. uh H1; ee; am. 
rw H3. rww ob_source. ap mor_lf_forward.
sh s; am. 

assert (target u = source (lf_backward u)).
rw source_lf_backward. tv. uh H1; ee; am. 
rw H4. rww ob_source. ap mor_lf_backward.
sh s; am. 

assert (source v = source (lf_forward v)).
rw source_lf_forward. tv. uh H2; ee; am. 
rw H5. rww ob_source. ap mor_lf_forward.
sh s; am. 

assert (target v = source (lf_backward v)).
rw source_lf_backward. tv. uh H2; ee; am. 
rw H6. rww ob_source. ap mor_lf_backward.
sh s; am. 

uh H. nin H. ee. 
transitivity (source x).

uh H. ee. nin H12. 
ee. wr H14. rww source_lf_extend. 

uh H7. ee. nin H12; ee. 
wr H14. rww source_lf_extend. 

uh H. nin H. ee. 

transitivity (target x).
uh H; ee. nin H13. ee. wr H15. 
rww target_lf_extend. 

uh H8. ee. nin H13. ee. 
wr H15. rww target_lf_extend. 
Qed. 


Lemma lf_ob_target : forall a u,
(exists s, (is_lf_symbol a s u)) -> 
ob a (target u).
Proof.
ir. nin H. 
assert (target u = source (lf_backward u)).
rww source_lf_backward. uh H; ee; am. 
rw H0. rww ob_source. 
ap mor_lf_backward. sh x; am. 
Qed. 

Lemma lf_ob_source : forall a u,
(exists s, (is_lf_symbol a s u)) -> 
ob a (source u).
Proof.
ir. nin H. 
assert (source u = source (lf_forward u)).
rww source_lf_forward. uh H; ee; am. 
rw H0. rww ob_source. 
ap mor_lf_forward. sh x; am. 
Qed. 


Lemma rqcat_equiv_rel_lfer : forall a s,
has_left_fractions a s -> 
rqcat_equiv_rel (lfc_rqcat a s) (lfer a s).
Proof.
ir. 


uhg; ee; ir.

app rqcat_lfc_rqcat. 
ap show_equivalence_relation. 
uhg. ir. 
rwi inc_lfer H0. ee; am. am. 
ir. rwi related_lfer H0. 
rw related_lfer. app lf_equiv_symm. am. am. 

ir. rwi related_lfer H0. rwi related_lfer H1. 
rw related_lfer. 
ap lf_equiv_trans. am. sh y. ee; am. am.
am. am. 

rwi related_lfer_rw H0; try am. ee. 
rw is_mor_lfc_rqcat. am. am. 

rwi related_lfer_rw H0; try am. ee. 
rw is_mor_lfc_rqcat. am. am. 
rwi related_lfer_rw H0; try am. ee.
am. 
rwi related_lfer_rw H0; try am. ee.
am. 

rw related_lfer. ap lf_equiv_refl. am. 
rwi is_mor_lfc_rqcat H0. am. am. 
am. 

rwi related_lfer_rw H0. 
rwi related_lfer_rw H1. ee. 
rw related_lfer. 
rw comp_lfc_rqcat. rw comp_lfc_rqcat. 
ap lf_comp_indep. 
am. am. am. am. am. am. am. wr H8. wrr H5. am. 
am. am. am. am. am. am. 


rwi is_mor_lfc_rqcat H0. 
assert (ob a (target u)). 
ap lf_ob_target. sh s; am. 
rww related_lfer.
rww comp_lfc_rqcat. 
rww id_lfc_rqcat. 
app lf_left_id. 
rww id_lfc_rqcat. 
app is_lf_symbol_lf_id_rep. 
rww id_lfc_rqcat. 
rww source_lf_id_rep. am. 

rwi is_mor_lfc_rqcat H0. 
assert (ob a (source u)).
ap lf_ob_source. sh s; am. 
rww comp_lfc_rqcat. 
rww id_lfc_rqcat. 
rww related_lfer. 
app lf_right_id. 
rww id_lfc_rqcat. 
app is_lf_symbol_lf_id_rep. 
rww id_lfc_rqcat. 
rww target_lf_id_rep. am. 


rwi is_mor_lfc_rqcat H0. 
rwi is_mor_lfc_rqcat H1. 
rwi is_mor_lfc_rqcat H2. 
rww related_lfer. 
rww comp_lfc_rqcat. rww comp_lfc_rqcat. 
rww comp_lfc_rqcat. rww comp_lfc_rqcat. 
app lf_comp_rep_assoc. 
rww comp_lfc_rqcat. 
app is_lf_symbol_lf_comp_rep. 
rww comp_lfc_rqcat. rww target_lf_comp_rep.
rww comp_lfc_rqcat. app is_lf_symbol_lf_comp_rep.
rww comp_lfc_rqcat. rww source_lf_comp_rep. 
am. am. am. 
Qed.

Definition left_frac_cat a s :=
quotient_cat (lfc_rqcat a s) (lfer a s).

Lemma left_frac_cat_axioms : forall a s,
has_left_fractions a s -> 
Category.axioms (left_frac_cat a s). 
Proof.
ir. 
uf left_frac_cat. 
ap rq_quotient_cat_axioms. 
app rqcat_equiv_rel_lfer. 
Qed.


Definition lf_class a s u := arrow_class (lfer a s) u.

Lemma source_lf_class : forall a s u,
source (lf_class a s u) = source u.
Proof.
ir. uf lf_class. rww source_arrow_class.
Qed. 

Lemma target_lf_class : forall a s u,
target (lf_class a s u) = target u.
Proof.
ir. uf lf_class. rww target_arrow_class.
Qed. 

Lemma ob_left_frac_cat : forall a s x,
has_left_fractions a s ->
ob (left_frac_cat a s) x = ob a x.
Proof.
ir. ap iff_eq; ir. 
ufi left_frac_cat H0.
rwi rq_ob_quotient_cat H0. 
rwi is_ob_lfc_rqcat H0. 
am. am. 
app rqcat_equiv_rel_lfer. 

uf left_frac_cat. rw rq_ob_quotient_cat. 
rww is_ob_lfc_rqcat. 
app rqcat_equiv_rel_lfer. 
Qed.

Lemma mor_left_frac_cat : forall a s v,
has_left_fractions a s ->
mor (left_frac_cat a s) v =
(exists u, (is_lf_symbol a s u & v = lf_class a s u)).
Proof.
ir. ap iff_eq; ir. 
ufi left_frac_cat H0.
rwi rq_mor_quotient_cat H0. 
uh H0. 
ee. nin H1; ee. 
sh x. ee. 
rwi is_mor_lfc_rqcat H1. am. am. am. 
app rqcat_equiv_rel_lfer. 
nin H0. 
ee. uf left_frac_cat. 
rw rq_mor_quotient_cat. uhg; ee.
app rqcat_equiv_rel_lfer. 
sh x. ee. rww is_mor_lfc_rqcat. 
am. app rqcat_equiv_rel_lfer. 
Qed.


Lemma comp_left_frac_cat_lf_class : forall a s u v,
has_left_fractions a s ->
is_lf_symbol a s u -> is_lf_symbol a s v ->
source u = target v ->
comp (left_frac_cat a s) (lf_class a s u) (lf_class a s v) =
lf_class a s (lf_comp_rep a s u v).
Proof.
ir. 
uf left_frac_cat. 
rw rq_comp_quotient_cat. 
uf lf_class. 
rw rq_quot_comp_arrow_class. 
rw comp_lfc_rqcat. tv. 
am. am. am. am. 
app rqcat_equiv_rel_lfer. 
rww is_mor_lfc_rqcat. 
rww is_mor_lfc_rqcat. 
am. 
app rqcat_equiv_rel_lfer. 
uhg; ee. 
app rqcat_equiv_rel_lfer. 
sh u. ee. 
rww is_mor_lfc_rqcat. tv. 
uhg; ee. 
app rqcat_equiv_rel_lfer. 
sh v. ee. 
rww is_mor_lfc_rqcat. tv. 
rww source_lf_class. 
rww target_lf_class. 
Qed.

Lemma id_left_frac_cat : forall a s x,
has_left_fractions a s -> ob a x ->
id (left_frac_cat a s) x = lf_class a s (lf_id_rep a x).
Proof.
ir. 
uf left_frac_cat. 
rw rq_id_quotient_cat. 
uf quot_id. rw id_lfc_rqcat. 
reflexivity. am. am. 
app rqcat_equiv_rel_lfer. 
rww is_ob_lfc_rqcat. 
Qed.

Lemma eq_lf_class : forall a s u v,
has_left_fractions a s ->
is_lf_symbol a s u -> is_lf_symbol a s v -> 
(lf_class a s u = lf_class a s v) = (lf_equiv a s u v). 
Proof.
ir. ap iff_eq; ir. 
ufi lf_class H2. 
wr related_lfer. 
rewrite <- rq_arrow_class_eq with (a:= (lfc_rqcat a s)).
am. 
app rqcat_equiv_rel_lfer. 
rww is_mor_lfc_rqcat. am. 

uf lf_class. 
rewrite rq_arrow_class_eq with (a:= (lfc_rqcat a s)).
rww related_lfer. 
app rqcat_equiv_rel_lfer. 
rww is_mor_lfc_rqcat.
Qed.



Definition lf_taut a s u := 
lf_class a s (taut_lf_symbol a u).

Definition lf_inverse a s u := 
lf_class a s (inverse_lf_symbol a u).

Lemma source_lf_taut : forall a s u,
source (lf_taut a s u) = source u.
Proof.
ir. uf lf_taut. 
rw source_lf_class. 
rww source_taut_lf_symbol.  
Qed.

Lemma target_lf_taut : forall a s u,
mor a u -> 
target (lf_taut a s u) = target u.
Proof.
ir. uf lf_taut. 
rw target_lf_class. 
rww target_taut_lf_symbol.  
Qed.

Lemma source_lf_inverse : forall a s u,
mor a u -> 
source (lf_inverse a s u) = target u.
Proof.
ir. uf lf_inverse. 
rw source_lf_class. 
rww source_inverse_lf_symbol.  
Qed.

Lemma target_lf_inverse : forall a s u,
mor a u -> 
target (lf_inverse a s u) = source u.
Proof.
ir. uf lf_inverse. 
rw target_lf_class. 
rww target_inverse_lf_symbol.  
Qed.


Lemma mor_lf_taut : forall a s u,
has_left_fractions a s -> mor a u ->
mor (left_frac_cat a s) (lf_taut a s u).
Proof.
ir. uf left_frac_cat. 
rw rq_mor_quotient_cat. 
uhg; ee. 
app rqcat_equiv_rel_lfer. 
sh (taut_lf_symbol a u). ee. 
rww is_mor_lfc_rqcat. 
app is_lf_symbol_taut_lf_symbol. 
reflexivity. 
app rqcat_equiv_rel_lfer. 
Qed.

Lemma mor_lf_inverse : forall a s u,
has_left_fractions a s -> inc u s -> 
mor (left_frac_cat a s) (lf_inverse a s u).
Proof.
ir. 
assert (mor a u).
ap inc_hlf_mor. sh s; ee; am. 
uf left_frac_cat. 
rw rq_mor_quotient_cat. 
uhg; ee. 
app rqcat_equiv_rel_lfer. 
sh (inverse_lf_symbol a u). ee. 
rww is_mor_lfc_rqcat. 
app is_lf_symbol_inverse_lf_symbol. 
reflexivity. 
app rqcat_equiv_rel_lfer. 
Qed.

Lemma lf_taut_id : forall a s x,
has_left_fractions a s -> ob a x ->  
lf_taut a s (id a x) = id (left_frac_cat a s) x.
Proof.
ir. 
uf left_frac_cat. 
rw rq_id_quotient_cat. 
uf quot_id. 
rw id_lfc_rqcat. 
uf lf_taut. 
rw taut_lf_symbol_id. 
reflexivity. am. am. am. 
app rqcat_equiv_rel_lfer. 
rww is_ob_lfc_rqcat. 
Qed.

Lemma comp_lf_class : forall a s u v,
has_left_fractions a s -> 
is_lf_symbol a s u -> is_lf_symbol a s v ->
source u = target v ->
comp (left_frac_cat a s) (lf_class a s u) (lf_class a s v) =
lf_class a s (lf_comp_rep a s u v).
Proof.
ir. 

assert (related (lfer a s) u (arrow_rep
(lf_class a s u))).
apply rq_related_arrow_rep with (a:= lfc_rqcat a s). 
app rqcat_equiv_rel_lfer. 
rww is_mor_lfc_rqcat. tv. 

assert (related (lfer a s) v (arrow_rep
(lf_class a s v))).
apply rq_related_arrow_rep with (a:= lfc_rqcat a s). 
app rqcat_equiv_rel_lfer. 
rww is_mor_lfc_rqcat. tv. 

rwi related_lfer_rw H3. 
rwi related_lfer_rw H4. 
ee. 



uf left_frac_cat.
rw rq_comp_quotient_cat. 
transitivity (lf_class a s (lf_comp_rep a s 
(arrow_rep (lf_class a s u)) (arrow_rep (lf_class a s v)))).

uf quot_comp. 
rw comp_lfc_rqcat. 
reflexivity. 
am. am. am. wr H10. wr H7. 
am. 

rw eq_lf_class. 
ap lf_comp_indep. 
am. app lf_equiv_symm. 
app lf_equiv_symm. 
wr H10. wrr H7. am. 
ap is_lf_symbol_lf_comp_rep. am. 
am. am. 
wr H10. wrr H7. 
app is_lf_symbol_lf_comp_rep. 
app rqcat_equiv_rel_lfer. 
uf lf_class. 
ap rq_quotient_arrow_arrow_class. 
app rqcat_equiv_rel_lfer. 
rww is_mor_lfc_rqcat. 
uf lf_class. 
ap rq_quotient_arrow_arrow_class. 
app rqcat_equiv_rel_lfer. 
rww is_mor_lfc_rqcat. 
rww source_lf_class. rww target_lf_class. am. am. 
Qed. 

Lemma comp_lf_taut : forall a s u v,
has_left_fractions a s ->
mor a u -> mor a v -> source u = target v ->
comp (left_frac_cat a s) (lf_taut a s u) (lf_taut a s v) =
lf_taut a s (comp a u v).
Proof.
ir. uf lf_taut. 
rw comp_lf_class. 
rww eq_lf_class. 
app comp_taut_lf_symbol. 
ap is_lf_symbol_lf_comp_rep. 
am. 
app is_lf_symbol_taut_lf_symbol. 
app is_lf_symbol_taut_lf_symbol. 
rww source_taut_lf_symbol. 
rww target_taut_lf_symbol. 
app is_lf_symbol_taut_lf_symbol. 
rww mor_comp. am. 
app is_lf_symbol_taut_lf_symbol. 
app is_lf_symbol_taut_lf_symbol. 
rww source_taut_lf_symbol. 
rww target_taut_lf_symbol. 
Qed. 

Lemma are_inverse_lf_taut_lf_inverse : forall a s u,
has_left_fractions a s -> inc u s ->
are_inverse (left_frac_cat a s) (lf_taut a s u) (lf_inverse a s u).
Proof.
ir. 
assert (mor a u).
ap inc_hlf_mor. sh s; ee; am. 

assert (is_lf_symbol a s (taut_lf_symbol a u)).
app is_lf_symbol_taut_lf_symbol. 
assert (is_lf_symbol a s (inverse_lf_symbol a u)).
app is_lf_symbol_inverse_lf_symbol. 
assert (source (taut_lf_symbol a u) = target (inverse_lf_symbol a u)).
rww source_taut_lf_symbol. 
rww target_inverse_lf_symbol. 
assert (source (inverse_lf_symbol a u) = target (taut_lf_symbol a u)).
rw source_inverse_lf_symbol. 
rww target_taut_lf_symbol. am. 



uhg; ee. 
app mor_lf_taut. app mor_lf_inverse. 
rw source_lf_taut. rww target_lf_inverse. 
rw source_lf_inverse. rww target_lf_taut. am. 

transitivity (lf_class a s (lf_comp_rep a s (taut_lf_symbol a u)
(inverse_lf_symbol a u))).
uf lf_taut. uf lf_inverse. 
rw comp_lf_class. reflexivity. 
am. am. am. am. 

rw id_left_frac_cat. 
rw eq_lf_class. 
assert (source (lf_inverse a s u) = target u).
rww source_lf_inverse. rw H6. 
app lf_right_inverse. am. 
ap is_lf_symbol_lf_comp_rep. 
am. am. am. am. 
ap is_lf_symbol_lf_id_rep. 
am. rw source_lf_inverse. rww ob_target. 
am. am. 
rw source_lf_inverse. rww ob_target. am. 

transitivity (lf_class a s (lf_comp_rep a s (inverse_lf_symbol a u)
(taut_lf_symbol a u))).
uf lf_taut. uf lf_inverse. 
rw comp_lf_class. reflexivity. 
am. am. am. am. 

rw id_left_frac_cat. 
rw eq_lf_class. 
assert (source (lf_taut a s u) = source u).
rww source_lf_taut. rw H6. 
app lf_left_inverse. am. 
ap is_lf_symbol_lf_comp_rep. 
am. am. am. am. 
ap is_lf_symbol_lf_id_rep. 
am. rw source_lf_taut. rww ob_source. 
am. 
rw source_lf_taut. rww ob_source. 
Qed.

Lemma is_lf_symbol_arrow_rep : forall a s y,
has_left_fractions a s ->
mor (left_frac_cat a s) y ->
is_lf_symbol a s (arrow_rep y).
Proof.
ir. 
assert (is_mor (lfc_rqcat a s) (arrow_rep y)).
apply rq_mor_arrow_rep with (r := lfer a s). 
ufi left_frac_cat H0. 
rwi rq_mor_quotient_cat H0. am. 
app rqcat_equiv_rel_lfer. 
rwi is_mor_lfc_rqcat H1. am. am. 
Qed.

Lemma lf_class_arrow_rep : forall a s y,
has_left_fractions a s ->
mor (left_frac_cat a s) y ->
lf_class a s (arrow_rep y) = y.
Proof.
ir. 
uf lf_class. 
rewrite rq_arrow_class_arrow_rep with (a:= lfc_rqcat a s). 
tv. 
ufi left_frac_cat H0. 
rwi rq_mor_quotient_cat H0. am. 
app rqcat_equiv_rel_lfer. 
Qed.

Lemma lf_source_arrow_rep : forall y,
(exists a, exists s, (has_left_fractions a s &
mor (left_frac_cat a s) y)) ->
source (arrow_rep y) = source y.
Proof.
ir. 
nin H. nin H. ee. 
cp (lf_class_arrow_rep H H0). 
transitivity (source (lf_class x x0 (arrow_rep y))).
rww source_lf_class. rww H1. 
Qed.

Lemma lf_target_arrow_rep : forall y,
(exists a, exists s, (has_left_fractions a s &
mor (left_frac_cat a s) y)) ->
target (arrow_rep y) = target y.
Proof.
ir. 
nin H. nin H. ee. 
cp (lf_class_arrow_rep H H0). 
transitivity (target (lf_class x x0 (arrow_rep y))).
rww target_lf_class. rww H1. 
Qed.

Lemma comp_etc_arrow_rep : forall a s y,
has_left_fractions a s -> 
mor (left_frac_cat a s) y ->
comp (left_frac_cat a s) 
(lf_inverse a s (lf_backward (arrow_rep y)))
(lf_taut a s (lf_forward (arrow_rep y))) = y.
Proof.
ir. 
transitivity (lf_class a s (arrow_rep y)).
set (k:= arrow_rep y).
assert (is_lf_symbol a s k).
uf k. 
ap is_lf_symbol_arrow_rep. 
am. am. 
assert (mor a (lf_forward k)).
ap mor_lf_forward. sh s; am. 
assert (mor a (lf_backward k)).
ap mor_lf_backward. sh s; am. 
assert (inc (lf_backward k) s).
ap inc_lf_backward. sh a; am. 

uf lf_inverse. uf lf_taut.
rw comp_lf_class. 
rw eq_lf_class.
app lf_equiv_symm.
ap lf_symbol_equiv. am.
am. am. 
ap is_lf_symbol_lf_comp_rep. 
am. ap is_lf_symbol_inverse_lf_symbol.
am. ap inc_lf_backward. sh a; am. 
ap is_lf_symbol_taut_lf_symbol. 
am. ap  mor_lf_forward. sh s; am. 
rw source_inverse_lf_symbol. 
rw target_taut_lf_symbol. 
rww target_lf_forward.
sh a; sh s; am. am. am. am. am. 
ap is_lf_symbol_inverse_lf_symbol.
am. ap inc_lf_backward. sh a; am. 
ap is_lf_symbol_taut_lf_symbol. 
am. ap  mor_lf_forward. sh s; am. 
rw source_inverse_lf_symbol. 
rw target_taut_lf_symbol. 
rww target_lf_forward.
sh a; sh s; am. am. am. 

ap lf_class_arrow_rep. am. am. 
Qed.

Lemma comp_etc_lf_symbol : forall a s k,
has_left_fractions a s -> 
is_lf_symbol a s k ->
comp (left_frac_cat a s) 
(lf_inverse a s (lf_backward k))
(lf_taut a s (lf_forward k)) = lf_class a s k.
Proof.
ir. 

assert (mor a (lf_forward k)).
ap mor_lf_forward. sh s; am. 
assert (mor a (lf_backward k)).
ap mor_lf_backward. sh s; am. 
assert (inc (lf_backward k) s).
ap inc_lf_backward. sh a; am. 

uf lf_inverse. uf lf_taut.
rw comp_lf_class. 
rw eq_lf_class.
app lf_equiv_symm.
ap lf_symbol_equiv. am.
am. am. 
ap is_lf_symbol_lf_comp_rep. 
am. ap is_lf_symbol_inverse_lf_symbol.
am. ap inc_lf_backward. sh a; am. 
ap is_lf_symbol_taut_lf_symbol. 
am. ap  mor_lf_forward. sh s; am. 
rw source_inverse_lf_symbol. 
rw target_taut_lf_symbol. 
rww target_lf_forward.
sh a; sh s; am. am. am. am. am. 
ap is_lf_symbol_inverse_lf_symbol.
am. ap inc_lf_backward. sh a; am. 
ap is_lf_symbol_taut_lf_symbol. 
am. ap  mor_lf_forward. sh s; am. 
rw source_inverse_lf_symbol. 
rw target_taut_lf_symbol. 
rww target_lf_forward.
sh a; sh s; am. am. am. 
Qed.

Lemma lfc_mor_expression : forall a s y,
has_left_fractions a s ->
mor (left_frac_cat a s) y ->
(exists u, exists v, (mor a u & inc v s & target u = target v &
y = comp  (left_frac_cat a s) (lf_inverse a s v) (lf_taut a s u))).
Proof.
ir. 
cp (is_lf_symbol_arrow_rep H H0).


sh (lf_forward (arrow_rep y)).
sh (lf_backward (arrow_rep y)).
ee. 
ap mor_lf_forward. 
sh s; am. 
ap inc_lf_backward. sh a; am. 
rww target_lf_forward. 
sh a; sh s; am. 
sy; ap comp_etc_arrow_rep. am. am. 
Qed.


(** Now we define the projection functor from [a] to
[left_frac_cat a s]. It turns out that it is
easier to do this directly than to use the
stuff about [qfunctor] at the end of the 
[Associating_Quotient] module above. **)

Definition lf_proj a s := 
Functor.create a (left_frac_cat a s) (lf_taut a s).

Lemma source_lf_proj : forall a s,
source (lf_proj a s) = a.
Proof.
ir. uf lf_proj. 
rw Functor.source_create. tv. 
Qed.

Lemma target_lf_proj : forall a s,
target (lf_proj a s) = (left_frac_cat a s).
Proof.
ir. uf lf_proj. 
rw Functor.target_create. tv. 
Qed.

Lemma lf_proj_property : forall a s,
has_left_fractions a s ->
Functor.property a (left_frac_cat a s) (fun (x:E)=> x)
(lf_taut a s).
Proof.
ir. 
uhg; ee; ir.
lu. 
app left_frac_cat_axioms. 
rww ob_left_frac_cat. 
rww lf_taut_id. 
app mor_lf_taut. 
rww source_lf_taut. 
rww target_lf_taut. 
rww comp_lf_taut. 
Qed. 

Lemma lf_proj_axioms : forall a s,
has_left_fractions a s -> 
Functor.axioms (lf_proj a s).
Proof.
ir. uf lf_proj. ap Functor.create_axioms. 
sh (fun (x:E)=> x).
ap lf_proj_property. am. 
Qed. 

Lemma fob_lf_proj : forall a s x,
has_left_fractions a s -> ob a x ->
fob (lf_proj a s) x = x.
Proof.
ir. 
cp (lf_proj_property H).
exact (fob_property_create H1 H0).  
Qed. 

Lemma fmor_lf_proj : forall a s y,
has_left_fractions a s -> mor a y ->
fmor (lf_proj a s) y = lf_taut a s y.
Proof.
ir. 
uf lf_proj. 
rw Functor.fmor_create. tv. am. 
Qed. 

Lemma invertible_fmor_lf_proj : forall a s y,
has_left_fractions a s -> inc y s ->
invertible (left_frac_cat a s) (fmor (lf_proj a s) y).
Proof.
ir. 
uhg. sh (lf_inverse a s y).
rw fmor_lf_proj. 

app are_inverse_lf_taut_lf_inverse.
am. ap inc_hlf_mor. sh s; ee; am. 
Qed.

Lemma inverse_fmor_lf_proj : forall a s y,
has_left_fractions a s -> inc y s ->
inverse (left_frac_cat a s) (fmor (lf_proj a s) y) =
lf_inverse a s y.
Proof.
ir. 
ap inverse_eq. 
rww fmor_lf_proj. app are_inverse_lf_taut_lf_inverse.
ap inc_hlf_mor. sh s; ee; am. 
Qed.

(** Next we define a functor [lf_dotted] whenever
we have a functor [f] with [source f = a] such 
that [fmor f y] is invertible when [inc y s]. This
is to get the universal property of [left_frac_cat]. **)

Definition lf_dotted_situation a s f :=
has_left_fractions a s &
Functor.axioms f &
source f = a &
(forall y, inc y s -> invertible (target f) (fmor f y)).

Definition lf_symb_dot_situation a s f u :=
lf_dotted_situation a s f &
is_lf_symbol a s u.

Definition lf_symb_dot_facts a s f u:=
lf_symb_dot_situation a s f u &
is_lf_symbol a s u &
lf_dotted_situation a s f &
has_left_fractions a s &
Functor.axioms f &
source f = a &
(forall y, inc y s -> invertible (target f) (fmor f y)) &
mor (source f) (lf_forward u) &
mor (source f) (lf_backward u) &
inc (lf_backward u) s &
mor (target f) (fmor f (lf_forward u)) &
mor (target f) (fmor f (lf_backward u)) &
lf_symbol_like u &
source (fmor f (lf_forward u)) = fob f (source u) &
source (fmor f (lf_backward u)) = fob f (target u) &
target (fmor f (lf_forward u)) = fob f (lf_vertex u) &
target (fmor f (lf_backward u)) = fob f (lf_vertex u) &
invertible (target f) (fmor f (lf_backward u)) &
mor (target f) (inverse (target f) (fmor f (lf_backward u))) &
source (inverse (target f) (fmor f (lf_backward u))) = 
fob f (lf_vertex u).

Lemma lf_symb_dot_situation_rw : forall a s f u,
lf_symb_dot_situation a s f u = lf_symb_dot_facts a s f u.
Proof.
ir. 
ap iff_eq; ir. 
uhg; dj.
am. 
uh H0; ee; am. uh H0; ee; am. 
uh H2; ee; am. uh H2; ee; am. 
uh H2; ee; am. uh H2; ee; au. 
ap mor_lf_forward. sh s. rww H5. 
ap mor_lf_backward. sh s. rww H5. 
ap inc_lf_backward. sh a; am. 
app mor_fmor. app mor_fmor.
uh H1; ee; am. 
rww source_fmor. rww source_lf_forward.
rww source_fmor. rww source_lf_backward.
rww target_fmor. 
rw target_lf_forward. tv. sh a; sh s; am.
rw target_fmor. rw target_lf_backward. tv. 
am. am. ap H6. am. 
ap mor_inverse. am. 
rw source_inverse. am. am. 

uh H; ee; am. 
Qed.




Definition lf_symb_dot (a s:E) f u :=
comp (target f) 
(inverse (target f) (fmor f (lf_backward u))) 
(fmor f (lf_forward u)).

Lemma source_lf_symb_dot : forall a s f u,
lf_symb_dot_situation a s f u ->
source (lf_symb_dot a s f u) = fob f (source u).
Proof.
ir. 
rwi lf_symb_dot_situation_rw H. 
uh H; ee.
uf lf_symb_dot.
rww source_comp. 
rww source_inverse. 
rww H14. 
Qed.

Lemma target_lf_symb_dot : forall a s f u,
lf_symb_dot_situation a s f u -> 
target (lf_symb_dot a s f u) = fob f (target u).
Proof.
ir. 
rwi lf_symb_dot_situation_rw H. 
uh H; ee.
uf lf_symb_dot.
rw target_comp. 
rww target_inverse. 
am. am. 
rww source_inverse. 
rww H14. 
Qed.

Lemma mor_lf_symb_dot : forall a s f u,
lf_symb_dot_situation a s f u -> 
mor (target f) (lf_symb_dot a s f u).
Proof.
ir. 
rwi lf_symb_dot_situation_rw H. 
uh H; ee.
uf lf_symb_dot. 
rww mor_comp. 
rww source_inverse. 
rww H14. 
Qed.

Lemma lf_symb_dot_beyond_invariant : forall a s f u v,
lf_symb_dot_situation a s f u ->
lf_beyond a s u v -> 
lf_symb_dot a s f u = lf_symb_dot a s f v.
Proof.
ir. 
rwi lf_symb_dot_situation_rw H. 
uh H; uh H0; ee.
nin H5. 
ee. 

uf lf_symb_dot. 


assert (fmor f (lf_forward v) = 
comp (target f) (fmor f x) (fmor f (lf_forward u))).
transitivity (fmor f (comp (source f) x (lf_forward u))).
ap uneq. wr H26.
rww lf_forward_lf_extend. rww H10. 
rww fmor_comp. rww H10. 
rww target_lf_forward. sh a; sh s; am. 

assert (fmor f (lf_backward v) = 
comp (target f) (fmor f x) (fmor f (lf_backward u))).
transitivity (fmor f (comp (source f) x (lf_backward u))).
ap uneq. wr H26.
rww lf_backward_lf_extend. rww H10. 
rww fmor_comp. rww H10. 

assert (target x = lf_vertex v).
wr H26. rww lf_vertex_lf_extend. 

assert (mor (source f) x).
rww H10. 


assert (fmor f x = comp (target f)
(fmor f (lf_backward v)) 
(inverse (target f) (fmor f (lf_backward u)))).
rw H28. 
rw assoc. rw right_inverse. 
assert (target (fmor f (lf_backward u)) = 
source (fmor f x)).
rw H21. rw source_fmor. rww H25. 
am. am. 
rw H31. rww right_id. rww source_fmor. 
app ob_fob. rw H25. rw H10. ap ob_lf_vertex. 
sh s; am. app mor_fmor. 
am. app mor_fmor. 
am. am. 
rww source_fmor. rw H21. rww H25. 
rww target_inverse. tv. 

rw H27. rw H31.
set (c:= fmor f (lf_forward u)).
set (d:= fmor f (lf_backward u)).
set (e:= fmor f (lf_backward v)).
set (b:= target f).

assert (mor b c).
am. 
 
assert (mor b d).
am. 

assert (mor b e).
uf e; uf b. app mor_fmor. 
rw H10. ap mor_lf_backward. sh s; am. 

assert (invertible b d).
am. 

assert (invertible b e).
uf b; uf e. 
ap H11. ap inc_lf_backward. sh a; am. 

assert (target d = target c).
uf c; uf d. rw H20. am. 

assert (source e = source d).
uf e; uf d. rw source_fmor.
rw source_fmor. ap uneq. 
rw source_lf_backward. rw source_lf_backward. sy; am. 
am. uh H2; ee; am. am. rw H10. 
ap mor_lf_backward. sh s; am. am. 
rw H10. ap mor_lf_backward. sh s; am. 

assert (mor b (inverse b d)).
app mor_inverse. 
assert (mor b (inverse b e)).
app mor_inverse. 

rw assoc. 
wr assoc. 
rw left_inverse. 
rw left_id. reflexivity. 
rww ob_source. 
rww mor_comp. 
rww source_inverse. 
rww target_comp. rww target_inverse. sy; am. 
rww source_inverse. tv. am. am. am. 
rww mor_comp. rww source_inverse. 
rww source_inverse. rww target_comp. rww target_inverse. 
rww source_inverse. tv. am. 
app mor_inverse. am. rww target_inverse. rww source_inverse.
tv. 
Qed.


Lemma lf_symb_dot_equiv_invariant : forall a s f u v,
lf_symb_dot_situation a s f u ->
lf_equiv a s u v -> 
lf_symb_dot a s f u = lf_symb_dot a s f v.
Proof.
ir. uh H0; ee. 
nin H0. ee. 
transitivity (lf_symb_dot a s f x).
ap lf_symb_dot_beyond_invariant. am. am. 
sy. ap lf_symb_dot_beyond_invariant. 
uhg; ee. lu. uh H1. ee; am. am. 
Qed.


Lemma lf_symb_dot_make_comp : forall a s f u v w,
lf_symb_dot_situation a s f u ->
lf_symb_dot_situation a s f v ->
fills_in a s u v w ->
lf_symb_dot a s f (lf_make_comp a s u v w) =
comp (target f) (lf_symb_dot a s f u) (lf_symb_dot a s f v).
Proof.
ir. 

uf lf_symb_dot. 
rw lf_backward_lf_make_comp. rw lf_forward_lf_make_comp.
assert (lem1 : source u = target v).
uh H1; ee. am. 
assert (lf_symb_dot_situation a s f w).
uhg; ee. 
lu. uh H1; ee; am. 


assert (a = source f & mor (source f) (lf_backward w) &
mor (source f) (lf_backward u) & 
source (lf_backward w) = target (lf_backward u) &
mor (source f) (lf_forward w) & mor (source f) (lf_forward v) &
source (lf_forward w) = target (lf_forward v)).
uh H; uh H0; uh H2. dj; ee. 
uh H2; ee. sy; am. wr H3. ap mor_lf_backward. 
sh s. am. wr H3; ap mor_lf_backward. sh s; am. 
rw source_lf_backward. rw target_lf_backward. 
uh H1; ee; am. uh H6; ee; am. 
ap mor_lf_forward. wr H3; sh s; am. 
ap mor_lf_forward. wr H3; sh s; am. 
rw source_lf_forward. rw target_lf_forward.
uh H1; ee; am. sh a; sh s; am. uh H9; ee; am. 

ee. 
rw H3. 
rww fmor_comp. rww fmor_comp. 

set (c:= fmor f (lf_forward v)).
set (d:= fmor f (lf_backward v)).
set (e := fmor f (lf_forward u )).
set (g := fmor f (lf_backward u)).
set (h:= fmor f (lf_forward w)).
set (k:= fmor f (lf_backward w)).
set (b:= target f).

assert (mor b c & mor b d & mor b e & mor b g &
mor b h & mor b k & invertible b d & invertible b g &
invertible b k & 
target d = target c & target e = target g &
source d = source e & source h = target c &
source h = target d & source k = target e &
source k = target g & target h = target k &
comp b h d = comp b k e).




rwi lf_symb_dot_situation_rw H;
rwi lf_symb_dot_situation_rw H0; 
rwi lf_symb_dot_situation_rw H2; 
uh H; uh H0; uh H2; ee; try am. 

uf d; uf c.  rw target_fmor. rw target_fmor. 
ap uneq. rw target_lf_backward. rw target_lf_forward.
tv. sh a; sh s; am. am. am. am. am. 

(** To get the numbers easily in the following it
is best to draw a diagram and write down which rewrite
hypothesis numbers go with each end of each arrow. **)

uf e; uf g. rw H62; rw H63. reflexivity. 
uf d; uf e. rw H42. rw H60. app uneq. 
sy; am. 
uf h; uf c. rw H22. rw H43. ap uneq. uh H1; ee; am. 
uf h; uf d. rw H22. rw H44. ap uneq. uh H1; ee; am. 
uf k; uf e. rw H23. rw H62. ap uneq. uh H1; ee; am.
uf k; uf g. rw H23. rw H63. ap uneq. uh H1; ee; am. 
uf h; uf k. rw H24; rw H25. reflexivity. 
uf b; uf h; uf d; uf k; uf e.
rw comp_fmor. rw comp_fmor.
ap uneq. wr H3. uh H1; ee; am. am. 
am. am. rw source_lf_backward. rw target_lf_forward.
uh H1; ee; am. sh a; sh s; am. 
am. am. 
am. am. 
rw source_lf_forward. rw target_lf_backward. uh H1; ee; am. 
am. 



(** Now we get to our main diagram chase, but
the notation has been simplified by all of the above. **)

ee. 

rw assoc. rw inverse_comp. rw assoc. 
ap uneq. 
wr assoc. wr assoc. 

assert (comp b (inverse b k) h = comp b e (inverse b d)).
transitivity (comp b (comp b (inverse b k) h) (comp b d (inverse b d))).
rw right_inverse. 
rw right_id. tv. rww ob_target. 
rww mor_comp. app mor_inverse. rww source_inverse.
sy; am. 
rww source_comp. app mor_inverse. rww source_inverse. 
sy; am. tv. am. 
assert (e = comp b (inverse b k) (comp b h d)).
rw H27. wr assoc. rw left_inverse. 
rw left_id. tv. rww ob_source. am. sy; am. tv. 
am. app mor_inverse. am. am. rww source_inverse. 
am. tv. 

rw H28. rw assoc. rw assoc. ap uneq. 
sy; ap assoc. am. am. app mor_inverse. 
am. rww target_inverse. tv. 
app mor_inverse. rww mor_comp. app mor_inverse. 
rww source_inverse. rww target_comp. 
sy; am. rww source_comp. rww target_inverse. 
tv. app mor_inverse. am. rww mor_comp. 
app mor_inverse. 
rww target_inverse. rww source_inverse. 
sy; am. rww target_comp. app mor_inverse. 
rww target_inverse. tv. 

rww H28. am. app mor_inverse. am. 
rww target_inverse. sy; am. rww source_inverse. tv. 
app mor_inverse. am. am. rww source_inverse. 
sy; am. am. tv. app mor_inverse. app mor_inverse. 
rww mor_comp. 
rww source_inverse. sy; rww target_inverse. 
rww source_inverse. rww target_comp. 
sy; am. tv. 
uhg; ee. uf b. rww category_axioms_target. 
lu. uhg; ee. app mor_is_mor. 
app mor_is_mor. am. am. am. 
app mor_inverse. am. 
rww mor_comp. app mor_inverse. rww source_inverse.
rww source_inverse. sy; am. 
rww target_comp. rww target_inverse. sy; am. 
app mor_inverse. rww source_inverse. tv. 
lu. lu.    
Qed.

Lemma lf_symb_dot_comp_rep : forall a s f u v,
lf_symb_dot_situation a s f u ->
lf_symb_dot_situation a s f v ->
source u = target v -> 
lf_symb_dot a s f (lf_comp_rep a s u v) =
comp (target f) (lf_symb_dot a s f u) (lf_symb_dot a s f v).
Proof.
ir. 
uf lf_comp_rep. 
ap lf_symb_dot_make_comp. 
am. am. 
app fills_in_lf_filler. uh H; ee. uh H; ee; am.
uh H; ee; am. uh H0; ee; am. 
Qed.

Lemma lf_symb_dot_id_rep : forall a s f x,
lf_dotted_situation a s f ->
ob a x ->
lf_symb_dot a s f (lf_id_rep a x) = id (target f) (fob f x).
Proof.
ir. 
uh H; ee. 
uf lf_symb_dot. 

rw lf_backward_lf_id_rep. 
rw lf_forward_lf_id_rep. 
rw fmor_id. 
rw left_inverse. 
rw source_id. tv. 
app  ob_fob. rww H2. 
uhg. sh (id (target f) (fob f x)).

assert (ob (target f) (fob f x)).
app ob_fob. rww H2. 
uhg; ee. ap mor_id. 
am. 
app mor_id. 
rww source_id. rww target_id. 
rww source_id. rww target_id. 
rww left_id. 
rww source_id. app mor_id. 
rww target_id. 
rww left_id. rww source_id. 
app mor_id. rww target_id. am. am. am. 
Qed.



Definition lf_dotted a s f :=
Functor.create (left_frac_cat a s) (target f) 
(fun u => lf_symb_dot a s f (arrow_rep u)).

Lemma source_lf_dotted : forall a s f,
source (lf_dotted a s f) = left_frac_cat a s.
Proof.
ir. uf lf_dotted. rww Functor.source_create. 
Qed. 

Lemma target_lf_dotted : forall a s f,
target (lf_dotted a s f) = target f.
Proof.
ir. uf lf_dotted. rww Functor.target_create. 
Qed.

Lemma lf_equiv_arrow_rep_lf_class : forall a s u,
has_left_fractions a s -> 
is_lf_symbol a s u -> 
lf_equiv a s u (arrow_rep (lf_class a s u)).
Proof.
ir. 
uf lf_class. 
wr related_lfer. 
apply rq_related_arrow_rep_arrow_class with (lfc_rqcat a s). 
app rqcat_equiv_rel_lfer. 
rww is_mor_lfc_rqcat. am. 
Qed. 

Lemma lf_dotted_property : forall a s f,
lf_dotted_situation a s f -> 
Functor.property (left_frac_cat a s) (target f)
(fob f) (fun u => lf_symb_dot a s f (arrow_rep u)).
Proof.
ir. 
uh H; ee. 
uhg; ee; ir. 
app left_frac_cat_axioms. 
rww category_axioms_target. 
rwi ob_left_frac_cat H3. 
app ob_fob. rww H1. am. 


transitivity (lf_symb_dot a s f (lf_id_rep a x)).
rww lf_symb_dot_id_rep. uhg; ee; am. 
rwi ob_left_frac_cat H3. am. am. 

ap lf_symb_dot_equiv_invariant. 
uhg; ee. uhg; ee; am. 
app is_lf_symbol_lf_id_rep. 
rwi ob_left_frac_cat H3. am. am. 

rw id_left_frac_cat. 
app lf_equiv_arrow_rep_lf_class. 
app is_lf_symbol_lf_id_rep. 
rwi ob_left_frac_cat H3. am. am. am. 
rwi ob_left_frac_cat H3. am. am. 

ap mor_lf_symb_dot. 
uhg; ee. uhg; ee; am. 
ap is_lf_symbol_arrow_rep. am. am. 
rw source_lf_symb_dot. 
rewrite rq_source_arrow_rep with 
(a:=lfc_rqcat a s) (r:=lfer a s). tv.
ufi left_frac_cat H3. 
rwi rq_mor_quotient_cat H3. am. 
app rqcat_equiv_rel_lfer. 

uhg; ee. uhg; ee; am. 
ap is_lf_symbol_arrow_rep. am. am. 

rw target_lf_symb_dot. 
rewrite rq_target_arrow_rep with 
(a:=lfc_rqcat a s) (r:=lfer a s). tv.
ufi left_frac_cat H3. 
rwi rq_mor_quotient_cat H3. am. 
app rqcat_equiv_rel_lfer. 

uhg; ee. uhg; ee; am. 
ap is_lf_symbol_arrow_rep. am. am. 

set (p:= arrow_rep u).
set (q:= arrow_rep v).
assert (lf_symb_dot_situation a s f p).
uhg; ee. uhg; ee; am. 
uf p. app is_lf_symbol_arrow_rep. 
assert (lf_symb_dot_situation a s f q).
uhg; ee. uhg; ee; am. 
uf q. app is_lf_symbol_arrow_rep. 

assert (source p = target q).
uf p; uf q. 
rewrite rq_source_arrow_rep with 
(a:=lfc_rqcat a s) (r:=lfer a s). 
rewrite rq_target_arrow_rep with 
(a:=lfc_rqcat a s) (r:=lfer a s). am. 
ufi left_frac_cat H4. 
rwi rq_mor_quotient_cat H4. am. 
app rqcat_equiv_rel_lfer. 
ufi left_frac_cat H3. 
rwi rq_mor_quotient_cat H3. am. 
app rqcat_equiv_rel_lfer. 

transitivity (lf_symb_dot a s f (lf_comp_rep a s p q)).
sy; app lf_symb_dot_comp_rep . 

assert (u = lf_class a s p).
uf p. rw lf_class_arrow_rep. tv. am. 
am. 
assert (v = lf_class a s q).
uf q. rw lf_class_arrow_rep. tv. am. 
am. 

rw H9; rw H10. 

rw comp_lf_class. 
ap lf_symb_dot_equiv_invariant. 
uhg; ee. uhg; ee; am. 
ap is_lf_symbol_lf_comp_rep. am. uh H6; ee; am. 
uh H7; ee; am. am. 
ap lf_equiv_arrow_rep_lf_class. am. 
app is_lf_symbol_lf_comp_rep. uh H6; ee; am. 
uh H7; ee; am. am. uh H6; ee; am. 
uh H7; ee; am. am. 
Qed.

Lemma lf_dotted_axioms : forall a s f,
lf_dotted_situation a s f ->
Functor.axioms (lf_dotted a s f).
Proof.
ir. 
uf lf_dotted. 
ap Functor.create_axioms. 
sh (fob f). 
ap lf_dotted_property. 
am. 
Qed.


Lemma fob_lf_dotted : forall a s f x,
lf_dotted_situation a s f -> 
ob a x ->
fob (lf_dotted a s f) x = fob f x.
Proof.
ir. 
uf lf_dotted. 
ap fob_property_create. 
app lf_dotted_property. 
rww ob_left_frac_cat. uh H; ee; am. 
Qed. 

Lemma fmor_lf_dotted : forall a s f u,
mor (left_frac_cat a s) u -> 
fmor (lf_dotted a s f) u = lf_symb_dot a s f (arrow_rep u).
Proof.
ir.
uf lf_dotted. 
rww fmor_create. 
Qed.

Lemma fmor_lf_dotted_lf_class : forall a s f u,
lf_dotted_situation a s f ->
is_lf_symbol a s u ->
fmor (lf_dotted a s f) (lf_class a s u) = lf_symb_dot a s f u.
Proof.
ir. 
rw fmor_lf_dotted. 
ap lf_symb_dot_equiv_invariant.
uhg; ee.
am. 
ap is_lf_symbol_arrow_rep. uh H; ee; am.
rw mor_left_frac_cat. sh u. 
ee. am. tv. uh H; ee; am. 
ap lf_equiv_symm. 
ap lf_equiv_arrow_rep_lf_class. uh H; ee; am. am.

rw mor_left_frac_cat. sh u. ee. 
am. tv. uh H; ee; am. 
Qed.

(** For some reason these useful lemmas aren't in
the category theory file; they need to be put there. **)



Lemma fmor_lf_dotted_lf_taut : forall a s f y,
lf_dotted_situation a s f ->
mor a y -> 
fmor (lf_dotted a s f) (lf_taut a s y) = fmor f y.
Proof.
ir. 
uf lf_taut. 
cp H. 
uh H1; ee. 
cp H0. wri H3 H5. 
rw fmor_lf_dotted_lf_class. 

uf lf_symb_dot. 
rw lf_backward_taut_lf_symbol.
rw fmor_id. 
rw lf_forward_taut_lf_symbol. 
rw inverse_id. 
rw left_id. tv. app ob_fob. 
rww ob_target. 
app mor_fmor. 
rww target_fmor. tv. tv. 
app  ob_fob. rww ob_target.
am. am. rww ob_target.
am. 
ap is_lf_symbol_taut_lf_symbol. am. am. 
Qed.


Lemma fmor_lf_dotted_lf_inverse : forall a s f y,
lf_dotted_situation a s f ->
inc y s -> 
fmor (lf_dotted a s f) (lf_inverse a s y) = 
inverse (target f) (fmor f y).
Proof.
ir. 
uf lf_inverse. 
cp H. 
uh H1; ee. 
assert (mor a y).
ap inc_hlf_mor. sh s; ee; am. 
cp H5. wri H3 H5. 
rww fmor_lf_dotted_lf_class. 

assert (invertible (target f) (fmor f y)).
au. 

uf lf_symb_dot.
rw lf_backward_inverse_lf_symbol.
rw lf_forward_inverse_lf_symbol.
rw fmor_id. 
rw right_id. tv. 
app ob_fob. rww ob_target. 
app mor_inverse. rww source_inverse. 
rww target_fmor. tv. am. am. 
rww ob_target. 
app is_lf_symbol_inverse_lf_symbol.
Qed.

(** The following lemma shows that [lf_dotted a s f]
solves the problem of giving a functor which 
when composed with [lf_proj a s] yields [f]. **)

Lemma fcompose_lf_dotted_lf_proj : forall a s f,
lf_dotted_situation a s f ->
fcompose (lf_dotted a s f) (lf_proj a s) = f.
Proof.
ir. cp H. uh H0; ee.

ap Functor.axioms_extensionality.
ap fcompose_axioms. 
app lf_dotted_axioms. app lf_proj_axioms. 
rww source_lf_dotted. rww target_lf_proj.
am. rww source_fcompose. rww source_lf_proj.
sy; am. rww target_fcompose. 
rww target_lf_dotted. 

ir. 
rwi source_fcompose H4. 
rwi source_lf_proj H4. 

rw fmor_fcompose. 
rw fmor_lf_proj. 
rw fmor_lf_dotted_lf_taut. tv. am. am. 
am. am. 
app lf_dotted_axioms. 
app lf_proj_axioms. 
rww source_lf_dotted. rww target_lf_proj. 
rww source_lf_proj. 
Qed.

(** The following lemma shows that the solution to the
universal problem  posed above is unique. **)

Lemma lf_dotted_like_unique : forall a s g h,
has_left_fractions a s ->
Functor.axioms g -> Functor.axioms h ->
source g = left_frac_cat a s ->
source h = left_frac_cat a s ->
(fcompose g (lf_proj a s) = fcompose h (lf_proj a s)) ->
g = h.
Proof.
ir. 
assert (target g = target h).
transitivity (target (fcompose g (lf_proj a s))).
rww target_fcompose. rw H4. 
rww target_fcompose. 

ap Functor.axioms_extensionality.
am. am. rww H3. am. 

assert (forall y, mor a y -> 
fmor g (lf_taut a s y) = fmor h (lf_taut a s y)).
ir. 
wr fmor_lf_proj. 
wr fmor_fcompose. 
rw H4. rw fmor_fcompose. tv. am. 
app lf_proj_axioms. rww target_lf_proj. 
rww source_lf_proj. am. 
app lf_proj_axioms. rww target_lf_proj. 
rww source_lf_proj. am. am. 


assert (forall y, inc y s -> 
fmor g (lf_inverse a s y) = fmor h (lf_inverse a s y)).
ir. 
assert (mor a y).
ap inc_hlf_mor. sh s; ee; am. 

wr inverse_fmor_lf_proj. 
rw fmor_inverse. 
rw fmor_inverse. rww H5. 
ap uneq. rw fmor_lf_proj. 
au. am. am. am. 
rw H3. ap invertible_fmor_lf_proj. am. am. am. am. 
rw H2. ap invertible_fmor_lf_proj. am. am. am. am. 
am. 


ir. rwi H2 H8. 
cp (lfc_mor_expression H H8).
nin H9. nin H9. ee. 
rw H12. 

rw fmor_comp. rw fmor_comp. 
rw H7. 
rw H6. rww H5. 
am. am. am. am. 
ap mor_lf_inverse. 
am. am. ap mor_lf_taut. am. am. 
rww source_lf_inverse. rww target_lf_taut. sy; am. 
ap inc_hlf_mor. 
sh s. ee; am. am. am. 
ap mor_lf_inverse. am. am. 
ap mor_lf_taut. am. am. 
rww source_lf_inverse. rww target_lf_taut. sy; am. 
ap inc_hlf_mor. sh s. 
ee; am. 
Qed.


End Left_Fraction_Category. 





(*****************************************************************************************)
(*****************************************************************************************)
(*****************************************************************************************)
(*****************************************************************************************)

Module GZ_Localization.
Export GZ_Thm.
Export Left_Fraction_Category. 

(** We start by some general considerations 
about the notion of localization. Before getting
started we give some lemmas to recall the definitions
of [localizing_system] and [multiplicative_system].
This is just for the reader who wishes to look at the
present file first before looking at the main
constructions  in [freecat.v], [qcat.v], [gzdef.v] and 
[gzfractions.v].
**)

Lemma localizing_system_recall : forall a s,
localizing_system a s = 
(Category.axioms a &
(forall u, inc u s -> mor a u)).
Proof.
ir. tv.
Qed.

Lemma multiplicative_system_recall : forall a s,
multiplicative_system a s = 
(localizing_system a s &
(forall y z, inc y s -> inc z s -> 
source y = target z -> inc (comp a y z) s)).
Proof.
ir. tv.
Qed.



Definition localizes a s f :=
localizing_system a s &
Functor.axioms f &
source f = a &
(forall y, inc y s -> invertible (target f) (fmor f y)).

Definition completes_triangle f g h :=
Functor.axioms f & Functor.axioms g & Functor.axioms h &
source f = source g & source h = target f & 
target h = target g & fcompose h f = g.


Definition dotted_choice f g := 
choose (completes_triangle f g).

Lemma completes_triangle_dotted_choice : forall f g,
completes_triangle f g (dotted_choice f g) = 
(exists h, (completes_triangle f g h)).
Proof.
ir. 
ap iff_eq; ir. 
sh (dotted_choice f g).
am. 
exact (choose_pr H). 
Qed.


Definition is_localization a s f :=
localizes a s f &
(forall g, (localizes a s g -> 
completes_triangle f g (dotted_choice f g))) &
(forall g h, completes_triangle f g h -> 
h = dotted_choice f g).


Lemma dotted_choice_axioms : forall f g,
(exists a, exists s, (is_localization a s f & localizes a s g)) ->
Functor.axioms (dotted_choice f g).
Proof.
ir. 
nin H. nin H. ee. cp H0; uh H; ee.
cp (H2 _ H1). 
uh H4. ee; am. 
Qed.

Lemma source_dotted_choice : forall f g,
(exists a, exists s, (is_localization a s f & localizes a s g)) ->
source (dotted_choice f g) = target f.
Proof.
ir. 
nin H. nin H. ee. cp H0; uh H; ee.
cp (H2 _ H1). 
uh H4. ee; am. 
Qed.

Lemma target_dotted_choice : forall f g,
(exists a, exists s, (is_localization a s f & localizes a s g)) ->
target (dotted_choice f g) = target g.
Proof.
ir. 
nin H. nin H. ee. cp H0; uh H; ee.
cp (H2 _ H1). 
uh H4. ee; am. 
Qed.

Lemma fcompose_dotted_choice : forall f g,
(exists a, exists s, (is_localization a s f & localizes a s g)) ->
fcompose (dotted_choice f g) f = g.
Proof.
ir. 
nin H. nin H. ee. cp H0; uh H; ee.
cp (H2 _ H1). 
uh H4. ee; am. 
Qed.

Lemma localizes_fcompose : forall a s f g,
localizes a s f -> Functor.axioms g -> source g = target f ->
localizes a s (fcompose g f).
Proof.
ir. 
uh H; ee. uhg; ee.
am. app fcompose_axioms. 
rww source_fcompose. 
ir. 
rw fmor_fcompose. 
ap invertible_fmor. am. rw H1.
ap H4. am. rww target_fcompose. 
am. am. am. rw H3.
ap inc_ms_mor. sh s; ee; am. 
Qed.

Lemma eq_dotted_choice : forall f g h,
completes_triangle f g h ->
(exists a, exists s, (is_localization a s f)) ->
h = dotted_choice f g.
Proof.
ir. 
nin H0. nin H0. 
cp H0. uh H1; ee. ap H3. am. 
Qed. 

Lemma fcompose_dotted_choice_dotted_choice : forall f g h,
(exists a, exists s, (is_localization a s f & is_localization a s g &
localizes a s h)) ->
fcompose (dotted_choice g h) (dotted_choice f g) =
dotted_choice f h.
Proof.
ir. 
nin H. nin H. ee. 
ap eq_dotted_choice. 
cp H0. uh H2; ee. 
uhg; ee. 
uh H; ee. uh H; ee; am. uh H1; ee; am. 
ap fcompose_axioms. app dotted_choice_axioms. 
sh x; sh x0; ee; try am. 
app dotted_choice_axioms. 

sh x; sh x0; ee; try am. 
rw source_dotted_choice.
rw target_dotted_choice. tv. 
sh x; sh x0; ee; try am. 
 sh x; sh x0; ee; try am. 
uh H; ee. uh H; ee. 
rw H8. uh H1; ee. 
rww H11. 

rw source_fcompose. rw source_dotted_choice. 
tv. sh x; sh x0; ee; try am. 
rw target_fcompose. 
rww target_dotted_choice. 
sh x; sh x0; ee; try am.
rw fcompose_assoc. 
rw fcompose_dotted_choice. rw fcompose_dotted_choice. tv.
sh x; sh x0; ee; try am. 
sh x; sh x0; ee; try am. 
app dotted_choice_axioms.
sh x; sh x0; ee; try am. 
app dotted_choice_axioms.
sh x; sh x0; ee; try am. 
uh H; ee. uh H; ee; am. 
rw source_dotted_choice. 
rw target_dotted_choice. tv. 
sh x; sh x0; ee; try am. 
sh x; sh x0; ee; try am. 
rw source_dotted_choice. tv.
sh x; sh x0; ee; try am. 
sh x; sh x0; ee; try am. 
Qed. 

Lemma dotted_choice_refl : forall f,
(exists a, exists s, (is_localization a s f)) ->
dotted_choice f f = fidentity (target f).
Proof.
ir. 
sy. ap eq_dotted_choice. 
nin H. nin H. 
cp H. uh H0; ee. 
uh H0; ee. 
uhg; ee. am. am. rww fidentity_axioms.
rww category_axioms_target. 
tv. rww source_fidentity. 
rww target_fidentity. 
rw left_fidentity. tv. am. tv. 
am. 
Qed. 

(** Our main corollary is that two different localizations are 
isomorphic. **)

Lemma are_finverse_dotted_choice : forall f g,
(exists a, exists s, (is_localization a s f & is_localization a s g)) ->
are_finverse (dotted_choice f g) (dotted_choice g f).
Proof.
ir. 
nin H. nin H. ee. 
cp H; cp H0. uh H1; uh H2. 
ee. 
uhg; ee. 
ap dotted_choice_axioms. 
sh x; sh x0; ee; am. 
ap dotted_choice_axioms. 
sh x; sh x0; ee; am. 
rw source_dotted_choice. 
rw target_dotted_choice. tv. 
sh x; sh x0; ee; am. 
sh x; sh x0; ee; am. 

rw source_dotted_choice. 
rw target_dotted_choice. tv. 
sh x; sh x0; ee; am. 
sh x; sh x0; ee; am. 

rw fcompose_dotted_choice_dotted_choice.
rw source_dotted_choice. 
rw dotted_choice_refl. tv. 
sh x; sh x0; ee; am. 
sh x; sh x0; ee; am. 
sh x; sh x0; ee; try am. 

rw fcompose_dotted_choice_dotted_choice.
rw source_dotted_choice. 
rw dotted_choice_refl. tv. 
sh x; sh x0; ee; am. 
sh x; sh x0; ee; am. 
sh x; sh x0; ee; try am. 
Qed.

Lemma has_finverse_dotted_choice : forall f g,
(exists a, exists s, (is_localization a s f & is_localization a s g)) ->
has_finverse (dotted_choice f g).
Proof.
ir. 
uhg; ee. sh (dotted_choice g f). 
app are_finverse_dotted_choice. 
Qed. 

Lemma finverse_dotted_choice : forall f g,
(exists a, exists s, (is_localization a s f & is_localization a s g)) ->
finverse (dotted_choice f g) = dotted_choice g f.
Proof.
ir. 
apply finverse_unique with (f:= (dotted_choice f g)).

ap finverse_pr. app has_finverse_dotted_choice. 
app are_finverse_dotted_choice. 
Qed. 

(** Now we point out that our two constructions, one general and one under
the hypothesis [has_left_fractions a s], are localizations in the above sense. 
This allows us to deduce that they are isomorphic. **)

Lemma is_localization_gz_proj : forall a s,
localizing_system a s ->
is_localization a s (gz_proj a s).
Proof.
ir. 
uhg; dj. 
uhg; ee. am. 
app gz_proj_axioms. 
rww source_gz_proj. 

ir. 

(** The following is a bit silly for two reasons: one,
[localizes] was already defined before as [loc_compatible];
two, the lemma saying [loc_compatible a s (gz_proj a s)]
wasn't done, only a more general lemma [loc_compatible_fcompose]
was done so to get the special case we need to plug in
the [fidentity]. **)

assert (loc_compatible a s (gz_proj a s)).
assert (gz_proj a s = fcompose (fidentity (gz_loc a s))
(gz_proj a s)). sy. 
rw left_fidentity. tv. 
app gz_proj_axioms. 
rww target_gz_proj. 
rw H1. 
ap loc_compatible_fcompose. am. 
rww fidentity_axioms. 
app gz_loc_axioms. 
rww source_fidentity. 
uh H1; ee. au. 

ir. 
rw completes_triangle_dotted_choice. 
sh (gz_dotted a s g).
uhg; ee. 
app gz_proj_axioms. uh H1; ee; am. 
app gz_dotted_axioms. 
rww source_gz_proj. uh H1; ee; sy; am. 
rww source_gz_dotted. rww target_gz_proj. 
rww target_gz_dotted. rww fcompose_gz_dotted_gz_proj. 

ir. 
assert (localizes a s g).
uh H2; ee. wr H8. 
ap localizes_fcompose. am. am. 
am. cp (H1 g H3). 


apply gz_proj_epimorphic with (a:=a) (s:=s).
am. uh H2; ee. am. 
uh H4; ee; am. uh H2; ee. rw H8. rww target_gz_proj.

uh H4; ee. rw H8. rww target_gz_proj. 

uh H2; ee. rw H10. 
uh H4; ee. sy; am. 
Qed.

Lemma is_localization_lf_proj : forall a s,
has_left_fractions a s ->
is_localization a s (lf_proj a s).
Proof.
ir. 
uhg; dj. 
uhg; ee. uh H; ee; uh H; ee; am. 
app lf_proj_axioms. 
rww source_lf_proj. 

ir. 
rw target_lf_proj. 
ap invertible_fmor_lf_proj. am. am. 

rw completes_triangle_dotted_choice. 

(** Again it turns out that we basically had another
copy of [localizes] called [lf_dotted_situation],
the only difference being that the latter includes
[has_left_fractions]. This type of duplication is probably
inevitable (psychologically speaking) and it is probably
best not to worry too much about it. **)

assert (lf_dotted_situation a s g). 
uhg; ee. am. uh H1; ee; am. uh H1; ee; am.
uh H1; ee; am. 
sh (lf_dotted a s g). 

uhg; ee. 
app lf_proj_axioms. uh H1; ee; am. 
app lf_dotted_axioms. 
rww source_lf_proj. uh H1; ee; sy; am. 
rww source_lf_dotted. rww target_lf_proj. 
rww target_lf_dotted. 
rww fcompose_lf_dotted_lf_proj. 

assert (localizes a s g).
uh H2; ee. wr H8. 
app localizes_fcompose. 
cp (H1 g H3).

apply lf_dotted_like_unique with (a:=a) (s:=s).
am. uh H2; ee; am. 
uh H4; ee; am. uh H2; ee. 
rw H8. rww target_lf_proj. 
uh H4; ee. rw H8. rww target_lf_proj. 

uh H2; uh H4; ee. rww H10. 
Qed.

Lemma are_finverse_dotted_choice_gz_proj_lf_proj : forall a s,
has_left_fractions a s ->
are_finverse (dotted_choice (gz_proj a s) (lf_proj a s))
(dotted_choice (lf_proj a s) (gz_proj a s)). 
Proof.
ir. 
ap are_finverse_dotted_choice. 
sh a. sh s. 
ee. 
ap is_localization_gz_proj. uh H; ee; uh H; ee; am. 
ap is_localization_lf_proj. am. 
Qed.




(** Now we investigate how localization fits with 
the opposite category construction,
in order to obtain the right fraction 
construction directly from the left one. ***)

Definition oppms s := Image.create s flip.

Lemma inc_oppms : forall s y,
inc y (oppms s) = inc (flip y) s.
Proof.
ir. 
ap iff_eq; ir. 
ufi oppms H. rwi Image.inc_rw H. 
nin H. ee. wr H0. rww flip_flip. 
uf oppms. rw Image.inc_rw. 
sh (flip y). ee. am. rww flip_flip. 
Qed. 

Lemma oppms_oppms : forall s, oppms (oppms s) = s.
Proof.
ir. 
ap extensionality; uhg; ir. 
rwi inc_oppms H. 
rwi inc_oppms H. rwi flip_flip H. am. 
rw inc_oppms. rw inc_oppms. rww flip_flip. 
Qed. 

Lemma localizing_system_oppms : forall a s,
localizing_system (opp a) (oppms s) = localizing_system a s.
Proof.
assert (forall a s,
localizing_system (opp a) (oppms s) -> localizing_system a s).
ir. 
uh H; ee.
uhg; ee. 
rwi axioms_opp H. am. 
ir. assert (u = flip (flip u)).
rww flip_flip. rw H2. wr mor_opp. ap H0. 
rw inc_oppms. rww flip_flip. 

ir. ap iff_eq; ir. 
ap H. am. ap H. 
rw opp_opp. rw oppms_oppms. am.  
Qed.

Lemma multiplicative_system_oppms : forall a s,
multiplicative_system (opp a) (oppms s) = 
multiplicative_system a s.
Proof.
assert (forall a s, 
multiplicative_system (opp a) (oppms s) ->
multiplicative_system a s).
ir. uh H; ee.  
uhg; dj. rwi localizing_system_oppms H. am. 

ir. 
assert (mor a y). 
ap inc_ms_mor. sh s; ee; am. 
assert (mor a z). 
ap inc_ms_mor. sh s; ee; am. 

assert (comp a y z = flip (comp (opp a) (flip z) (flip y))).
rw comp_opp. rww flip_flip. 
rww flip_flip. rww flip_flip. 
rw mor_opp. rww flip_flip. 
rw  mor_opp. rww flip_flip. 
rw source_flip. rw target_flip. 
sy; am. alike. alike. 
rw H7. wr inc_oppms.  
ap H0. rw inc_oppms. rww flip_flip. 
rw inc_oppms. rww flip_flip. 
rw source_flip; try alike. 
rww target_flip; try alike. sy; am. 

ir. ap iff_eq; ir. 
ap H. am. ap H. 
rw opp_opp. rw oppms_oppms. am.  
Qed.

Lemma are_inverse_opp : forall a u v,
are_inverse (opp a) (flip u) (flip v) =
are_inverse a u v.
Proof.
assert (forall a u v,
are_inverse a u v -> are_inverse (opp a) (flip u) (flip v)).
ir. 
uh H; ee. 
uhg; ee. 
rww mor_opp. rww flip_flip. 
rw mor_opp. rww flip_flip. 
rw source_flip; try alike. 
rw target_flip; try alike. sy; am. 
rw source_flip; try alike. 
rw target_flip; try alike. sy; am. 
rw comp_opp. rw flip_flip. rw flip_flip.
rw H4. 
rw id_opp. rw source_flip; try alike. 
rww H1. 
rw ob_opp. 
rw source_flip; try alike. rww ob_target.
rw mor_opp. rww flip_flip. 
rw mor_opp. rww flip_flip. 
rw source_flip; try alike. 
rw target_flip; try alike. sy; am. 

rw comp_opp. rw flip_flip. rw flip_flip.
rw H3. 
rw id_opp. rw source_flip; try alike. 
rww H2. 
rw ob_opp. 
rw source_flip; try alike. rww ob_target.
rw mor_opp. rww flip_flip. 
rw mor_opp. rww flip_flip. 
rw source_flip; try alike. 
rw target_flip; try alike. sy; am. 

ir. 
ap iff_eq; ir.
assert (a = opp (opp a)).
rww opp_opp.
assert (u = flip (flip u)).
rww flip_flip. 
assert (v = flip (flip v)).
rww flip_flip. 
rw H1; rw H2; rw H3. 
ap H. am. 
au. 
Qed. 

Lemma invertible_opp : forall a u,
invertible (opp a) (flip u) = 
invertible a u.
Proof.
assert (forall a u, 
invertible a u -> invertible (opp a) (flip u)). 
ir. 
uhg; ee. 
uh H; ee. nin H. 
sh (flip x). 
rww are_inverse_opp. 

ir. ap iff_eq; ir. 
assert (a = opp (opp a)).
rww opp_opp.
assert (u = flip (flip u)).
rww flip_flip. 
rw H1; rw H2. ap H. am. au. 
Qed. 

Lemma localizes_oppms_oppf : forall a s f,
localizes (opp a) (oppms s) (oppf f) =
localizes a s f.
Proof.
assert (forall a s f, localizes a s f -> 
localizes (opp a) (oppms s) (oppf f)).
ir. 
uhg; ee. 
rw localizing_system_oppms. uh H; ee; am. 
app oppf_axioms. uh H; ee; am. 
rw source_oppf. ap uneq. uh H; ee; am. 
uh H; ee; am. 
ir. 
rw target_oppf. 
rw fmor_oppf. 
rw invertible_opp. 
uh H; ee. ap H3. wrr inc_oppms. 
uh H; ee; am. 
rww source_oppf. rw mor_opp. 
rwi inc_oppms H0. 
uh H; ee. rw H2. 
ap inc_ms_mor. sh s; ee; am. 
uh H; ee; am. uh H; ee; am. 

ir. ap  iff_eq; ir. 
assert (a = opp (opp a)).
rww opp_opp.
assert (s = oppms (oppms s)).
rww oppms_oppms.
assert (f = oppf (oppf f)).
rww oppf_oppf.
rw H1; rw H2; rw H3.
ap H. am. 
au. 
Qed.   

Lemma completes_triangle_oppf : forall f g h,
completes_triangle (oppf f) (oppf g) (oppf h) =
completes_triangle f g h.
Proof.
assert (forall f g h, completes_triangle f g h->
completes_triangle (oppf f) (oppf g) (oppf h)).
ir. uh H; ee. 
uhg; ee. app oppf_axioms. app oppf_axioms. 
app oppf_axioms. rww source_oppf. 
rw source_oppf. rww H2. 
am. rw source_oppf. rw target_oppf. 
rww H3. am. am. 
rw target_oppf. rw target_oppf. 
rww H4. am. am. 
rw fcompose_oppf. rww H5. am. am. am. 

ir. 
ap iff_eq; ir. 
assert (f = oppf (oppf f)). 
rww oppf_oppf. 
assert (g = oppf (oppf g)). 
rww oppf_oppf. 
assert (h = oppf (oppf h)). 
rww oppf_oppf. 
rw H1; rw H2; rw H3. app H. 
au. 
Qed. 

Lemma is_localization_oppms_oppf : forall a s f,
is_localization (opp a) (oppms s) (oppf f) =
is_localization a s f.
Proof.
assert (forall a s f, 
is_localization a s f -> 
is_localization (opp a) (oppms s) (oppf f) ).
ir. 
uhg; dj. 
rw localizes_oppms_oppf. uh H; ee; am. 
ir. 
assert (g = oppf (oppf g)). rww oppf_oppf. 
rwi H2 H1. 
rwi localizes_oppms_oppf H1. 
rw completes_triangle_dotted_choice. 
sh (oppf (dotted_choice f (oppf g))).
wr completes_triangle_oppf. 
rw oppf_oppf. rw oppf_oppf. 
uh H; ee. 
ap H3. am. 

ir. 
wri completes_triangle_oppf H2. 
rwi oppf_oppf H2. 

uh H; ee. cp (H4 _ _ H2). 
assert (completes_triangle f (oppf g) 
(oppf (dotted_choice (oppf f) g))).
wr completes_triangle_oppf.
rw oppf_oppf. 
rw oppf_oppf. 
ap H1. 
wri completes_triangle_oppf H2. 
rwi oppf_oppf H2. 
rwi oppf_oppf H2. 
uh H2; ee. wr H11. 
ap localizes_fcompose. am. am. 
am. 

cp (H4 _ _ H6). 
assert (h = oppf (oppf h)).
rww oppf_oppf. rw H8. 
rw H5.
wr H7.
rw oppf_oppf. tv. 

ir. 
ap iff_eq; ir. 
assert (a = opp (opp a)).
rww opp_opp.
assert (s = oppms (oppms s)).
rww oppms_oppms.
assert (f = oppf (oppf f)).
rww oppf_oppf.
rw H1; rw H2; rw H3.
ap H. am. 
app H. 
Qed. 

(** We thus obtain a rapid treatment of right fractions.
First recall the definition of left fractions, rewritten
slightly. **)

Lemma  has_left_fractions_rw : forall  a s,
has_left_fractions a s = (
multiplicative_system a s 
&
(forall x, ob a x -> inc (id a x) s) 
&
(forall r g, inc r s -> mor a g -> source r = source g ->
exists p, exists q, (mor a p & inc q s
& target p = target q &  source p = target r
& source q = target g & comp a q g =
comp a p r)) 
&
(forall v r t, inc v s -> mor a r -> mor a t ->
source r = target v -> source t = target v ->
comp a r v = comp a t v -> 
exists w, (inc w s & source w = target r & source w = target t
& comp a w r = comp a w t))).
Proof.
ir.
ap iff_eq; ir. 
uh H; ee; try am.
ir. cp (H1 r g H3 H4 H5). 
nin H6. 
ee. sh (lf_forward x). sh (lf_backward x).
ee; try am. ap mor_lf_forward. 
sh s; am. ap inc_lf_backward. sh a; am. 
rw target_lf_forward. rw target_lf_backward. 
tv. sh a; sh s; am. 
rw source_lf_forward. am. uh H6; ee; am. 
rw source_lf_backward. am. uh H6; ee; am. 
uhg; ee; try am. 
ir. 
cp (H1 r g H3 H4 H5). 
nin H6. nin H6; ee. 
sh (lf_symbol x x0). 
ee; try am. ap is_lf_symbol_lf_symbol. 
uhg; ee. uh H; ee; am. am. am. 
am. rw source_lf_symbol. am. rww target_lf_symbol. 
rw lf_backward_lf_symbol. 
rww lf_forward_lf_symbol.  
Qed. 

Definition has_right_fractions a s :=
multiplicative_system a s 
&
(forall x, ob a x -> inc (id a x) s) 
&
(forall r g, inc r s -> mor a g -> target r = target g ->
exists p, exists q, (mor a q & inc p s & 
source p = source q & target p = source g &
target q = source r & comp a g p =
comp a r q)) 
&
(forall v r t, inc v s -> mor a r -> mor a t ->
source v = target r -> source v = target t ->
comp a v r = comp a v t -> 
exists w, (inc w s & source r = target w & source t = target w
& comp a r w = comp a t w)).

Lemma has_right_fractions_rw : forall a s,
has_right_fractions a s = 
has_left_fractions (opp a) (oppms s).
Proof.
ir. 
ap iff_eq; ir.
rw has_left_fractions_rw.
uh H; ee. 
rw multiplicative_system_oppms. am. 
ir. rw inc_oppms. 
rw id_opp. rw flip_flip. ap H0.
rwi ob_opp H3. am. am. 

ir. 
assert (mor (opp a) r). 
ap inc_ms_mor. 
sh (oppms s). ee. 
wr localizing_system_oppms. 
rw oppms_oppms. rw opp_opp. uh H; ee; am. am. 
cp H4. 

rwi inc_oppms H3. 
rwi mor_opp H4. 

assert (target (flip r) = target (flip g)). 
rw target_flip. 
rw target_flip. am. alike. alike. 

cp (H1 (flip r) (flip g) H3 H4 H8). 
nin H9. nin H9. ee. 
assert (mor a x).
ap inc_ms_mor. sh s; ee; try am. 
uh H; ee; am. 
sh (flip x0). 
sh (flip x). ee. 
rw mor_opp. rww flip_flip. 
rw inc_oppms. rww flip_flip. 
rw target_flip; try alike. 
rw target_flip; try alike. sy; am. 
rw source_flip; try alike.
rwi source_flip H13; try alike. 
am. rw source_flip; try alike.
rwi source_flip H12; try alike. am. 
rw comp_opp. rw comp_opp. 
rw flip_flip. rw flip_flip. 
ap uneq. am. 
rw mor_opp. rww flip_flip. am. 
rw source_flip; try alike.
rwi source_flip H13; try alike. am. 

rw mor_opp. rww flip_flip. am. 
rw source_flip; try alike.
rwi source_flip H12; try alike. am. 

ir. 
cp H4. cp H5. cp  H6. cp H7. 
assert (mor (opp a) v). 
rw mor_opp. 
ap inc_ms_mor. sh s; ee. 
uh H; ee; am. wrr inc_oppms. 

rwi inc_oppms H3. 
rwi mor_opp H4. rwi mor_opp H5. 
assert (target v = source (flip v)).
rww source_flip; try alike. 
wri target_flip H6; try alike. 
wri target_flip H7. rwi H14 H6. 
rwi H14 H7. 
assert (comp a (flip v) (flip r) = comp a (flip v) (flip t)).
transitivity (flip (flip (comp a (flip v) (flip r)))).
rww flip_flip. 
rwi comp_opp H8. rw H8. 
rw comp_opp. rww flip_flip. am. am. 
am. am. am. am. 

assert (source (flip v) = target (flip r)).
sy; am. 
assert (source (flip v) = target (flip t)).
sy; am. 

cp (H2 (flip v) (flip r) (flip t)
H3 H4 H5 H16 H17 H15).

nin H18. 
ee. 
assert (mor a x).
ap inc_ms_mor. sh s. ee. uh H; ee; am. am. 
sh (flip x). ee. 
rw inc_oppms.
rww flip_flip. 
rw source_flip; try alike. wr H19. 
rww source_flip; try alike. 
rw source_flip; try alike. wr H20. 
rww source_flip; try alike. 
rw comp_opp. rw flip_flip. 
rw comp_opp. rw flip_flip. rww H21. 
rw mor_opp. rww flip_flip. 
am. 
rw source_flip; try alike. wr H20. 
rww source_flip; try alike. 
rw mor_opp. rww flip_flip. 
am. 
rw source_flip; try alike. wr H19. 
rww source_flip; try alike. alike. 


(** Now we have to do essentially the same thing
in the other direction. **)

cp H.
rwi has_left_fractions_rw H0.
ee. 

uhg; ee.
wr multiplicative_system_oppms. 
am. 
ir.
wri ob_opp H4. cp (H1 x H4).
rwi id_opp H5. rwi inc_oppms H5. 
rwi flip_flip H5. am. am. 


ir. 
assert (mor a r).
ap inc_ms_mor. sh s; ee. 
wr localizing_system_oppms. uh H0; ee; am. 
am. 
assert (inc (flip r) (oppms s)).
rw inc_oppms. rww flip_flip. 
assert (mor (opp a) (flip g)).
rw mor_opp. rww flip_flip. 
assert (source (flip r) = source (flip g)).
rw source_flip; try alike. 
rw source_flip; try alike. am. 
cp (H2 _ _ H8 H9 H10). 
nin H11. nin H11. 
ee. 
assert (mor (opp a) x0).
ap inc_ms_mor. sh (oppms s); ee. 
uh H0; ee; am. am. 

sh (flip x0). sh (flip x). 
ee. wrr mor_opp. 
wrr inc_oppms. 
rw source_flip; try alike. 
rw source_flip; try alike. sy; am. 
rw target_flip; try alike. 
rwi target_flip H15; try alike. am. 
rw target_flip; try alike. 
rwi target_flip H14; try alike. am. 
rwi comp_opp H16. 
rwi flip_flip H16. rwi comp_opp H16. 
rwi flip_flip H16. 
transitivity (flip (flip (comp a g (flip x0)))).
rww flip_flip. rw H16. rww flip_flip. am. 
rw mor_opp. rww flip_flip. am. am. 
rw mor_opp. rww flip_flip. 
am. 


ir. 
assert (mor a v).
ap inc_ms_mor. sh s. 
ee. wr localizing_system_oppms. uh H0; ee; am. 
am. 

assert (inc (flip v) (oppms s)).
rw inc_oppms. rww flip_flip. 

assert (mor (opp a) (flip r)).
rw mor_opp. rww flip_flip. 
assert (mor (opp a) (flip t)).
rw mor_opp. rww flip_flip. 
assert (source (flip r) = target (flip v)).
rw source_flip; try alike. 
rw target_flip; try alike. sy; am. 
assert (source (flip t) = target (flip v)).
rw source_flip; try alike. 
rw target_flip; try alike. sy; am. 

assert (comp (opp a) (flip r) (flip v) = comp (opp a)
(flip t) (flip v)).
rw comp_opp. rw comp_opp. rw flip_flip. 
rw flip_flip. rw flip_flip. rww H9. 
rw mor_opp. rww flip_flip. 
 rw mor_opp. rww flip_flip. 
rw source_flip; try alike. 
rw target_flip; try alike. sy; am. 
rw mor_opp. rww flip_flip. 
rw mor_opp. rww flip_flip. 
rw source_flip; try alike. 
rw target_flip; try alike. sy; am. 

cp (H3 _ _ _ H11 H12 H13 H14 H15 H16).
nin H17. 
ee. 
assert (mor (opp a) x).
ap inc_ms_mor. sh (oppms s).
ee.
uh H0; ee; am. 
am. 

cp H18; cp H19. 
rwi target_flip H22; try alike. 
rwi target_flip H23; try alike. 

sh (flip x).
ee. wr inc_oppms. am. 
rw target_flip; try alike. sy; am. 
rw target_flip; try alike. sy; am. 
rwi comp_opp H20. 
rwi flip_flip H20. rwi comp_opp H20. 
rwi flip_flip H20. 
transitivity (flip (flip (comp a r (flip x)))).
rw flip_flip. reflexivity. 
rw H20. rw flip_flip. reflexivity. 
am. rw  mor_opp. rww flip_flip. 
am. am. rw mor_opp. rww flip_flip. 
am. 
Qed.


Definition right_frac_cat a s :=
opp (left_frac_cat (opp a) (oppms s)).

Definition rf_proj a s :=
oppf (lf_proj (opp a) (oppms s)).

Lemma right_frac_cat_axioms : forall a s,
has_right_fractions a s ->
Category.axioms (right_frac_cat a s).
Proof.
ir. 
uf right_frac_cat. 
ap opp_axioms. ap left_frac_cat_axioms.
rwi has_right_fractions_rw H. am. 
Qed.

Lemma rf_proj_axioms : forall a s,
has_right_fractions a s ->
Functor.axioms (rf_proj a s).
Proof.
ir. 
rwi has_right_fractions_rw H. 
uf rf_proj. ap oppf_axioms. 
ap lf_proj_axioms. am. 
Qed.

Lemma source_rf_proj : forall a s,
has_right_fractions a s ->
source (rf_proj a s) = a.
Proof.
ir. 
rwi has_right_fractions_rw H. 
uf rf_proj. 
rw source_oppf. 
rw source_lf_proj. rww opp_opp. 
app  lf_proj_axioms. 
Qed.


Lemma target_rf_proj : forall a s,
has_right_fractions a s ->
target (rf_proj a s) = right_frac_cat a s.
Proof.
ir. 
rwi has_right_fractions_rw H. 
uf rf_proj. 
rw target_oppf. 
rw target_lf_proj. tv. 
app  lf_proj_axioms. 
Qed.


Lemma is_localization_rf_proj : forall a s,
has_right_fractions a s ->
is_localization a s (rf_proj a s).
Proof.
ir. 
rwi has_right_fractions_rw H. 
uf rf_proj. 
wr is_localization_oppms_oppf. 
rw oppf_oppf. 
ap is_localization_lf_proj. am. 
Qed. 


(** We finish with the consequences of the 
left (or right) fraction conditions
on the description of arrows in the 
original [gz_localization]. In order
to attain a self-contained statement we avoid the notation
[lf_symbol] etc. from [gzfractions.v]. **)

Definition lf_vee a s p q :=
localizing_system a s &
mor a p & inc q s & target p = target q. 

Definition lf_vee_image f p q :=
comp (target f) (inverse (target f) (fmor f q)) 
(fmor f p).  

(** The following is basically a restatement of
the definition [lf_equiv] from [gzfractions.v]. **)

Definition lf_vee_equivalent a s p q r t :=
lf_vee a s p q & lf_vee a s r t & 
source p = source r & source q = source t &
(exists y, exists z, (mor a y & mor a z &
source y = target p & source z = target r &
target y = target z & 
comp a y p = comp a z r &
comp a y q = comp a z t &
inc (comp  a y q) s)).


Definition left_fraction_description a s f :=
localizes a s f &
ob_iso f 
&
(forall y, mor (target f) y -> 
exists p, exists q, (lf_vee a s p q &
y = lf_vee_image f p q)) 
&
(forall p q r t, lf_vee a s p q -> lf_vee a s r t ->
(lf_vee_image f p q = lf_vee_image f r t) ->
lf_vee_equivalent a s p q r t).


(** Dualize for the description of right fractions. **)

Definition rf_wedge a s p q :=
localizing_system a s &
mor a p & inc q s & source p = source q. 

Definition rf_wedge_image f p q :=
comp (target f) (fmor f p) (inverse (target f) (fmor f q)).


Definition rf_wedge_equivalent a s p q r t :=
rf_wedge a s p q & rf_wedge a s r t & 
target p = target r & target q = target t &
(exists y, exists z, (mor a y & mor a z &
target y = source p & target z = source r &
source y = source z & 
comp a p y = comp a r z &
comp a q y = comp a t z &
inc (comp  a q y) s)).


Definition right_fraction_description a s f :=
localizes a s f &
ob_iso f 
&
(forall y, mor (target f) y -> 
exists p, exists q, (rf_wedge a s p q &
y = rf_wedge_image f p q)) 
&
(forall p q r t, rf_wedge a s p q -> rf_wedge a s r t ->
(rf_wedge_image f p q = rf_wedge_image f r t) ->
rf_wedge_equivalent a s p q r t).

(** Now we get to the results concerning these descriptions.
The basic idea is that we can prove the
[left_fraction_description] for the construction 
of localization by left fractions. Then we want to prove
that this description is valid for any other localization
since they are all isomorphic. In particular it is valid
for the standard one. If one looks at the standard
construction this is a theorem which looks hard to prove
directly. Dualizing we get the same result for right fractions.
**)

Lemma lf_vee_image_lf_proj : forall a s p q, 
has_left_fractions a s -> 
lf_vee a s p q ->
lf_vee_image (lf_proj a s) p q = 
lf_class a s (lf_symbol p q). 
Proof.
ir. 
assert (is_lf_symbol a s (lf_symbol p q)).
ap is_lf_symbol_lf_symbol. uh H0;
uhg; ee. 
uh H; ee. uh H; ee; am. am. am. am. 
cp (comp_etc_lf_symbol H H1). 
wr H2.
uf lf_vee_image. 
rw target_lf_proj. 
rw inverse_fmor_lf_proj. 
rw lf_backward_lf_symbol. rw lf_forward_lf_symbol. 
rw fmor_lf_proj. tv. 
am. uh H0; ee; am. am. uh H0; ee; am. 
Qed.

Lemma left_fraction_description_lf_proj : forall a s,
has_left_fractions a s ->
left_fraction_description a s (lf_proj a s).
Proof.
ir.

cp (is_localization_lf_proj H). 


uhg; ee.
uh H0; ee; am. 
uhg. ee. 
uhg. ee. 
app lf_proj_axioms. 
ir. 
rwi source_lf_proj H1. rwi source_lf_proj H2. 
rwi fob_lf_proj H3. 
rwi fob_lf_proj H3. am. am. am. am. am. 

uhg. ee. app lf_proj_axioms. 
ir. rwi target_lf_proj H1. 
rwi ob_left_frac_cat H1. 
uhg. ee. 
app lf_proj_axioms. sh x. 
ee. rww source_lf_proj. 
rww fob_lf_proj. am. 


ir. rwi target_lf_proj H1. 
cp (lfc_mor_expression H H1). 
nin H2. nin H2. ee. 
sh x. sh x0. 
ee. uhg. ee. 
uh H; ee. uh H; ee; am. am. am. 
am. uf lf_vee_image. 
rw target_lf_proj. 
rw inverse_fmor_lf_proj. 
rw fmor_lf_proj. am. am. am. am. am. 

assert (localizing_system a s). 
uh H; ee; uh H; ee; am. 

ir. 
rwi lf_vee_image_lf_proj H4. 
rwi lf_vee_image_lf_proj H4. 
assert (lem1 : source p = source r).
transitivity (source (lf_class a s (lf_symbol p q))).
rw source_lf_class. rww source_lf_symbol. 
rw H4. rw source_lf_class. rww source_lf_symbol. 
assert (lem2 : source q = source t).
transitivity (target (lf_class a s (lf_symbol p q))).
rw target_lf_class. rww target_lf_symbol. 
rw H4. rw target_lf_class. rww target_lf_symbol. 


rwi eq_lf_class H4. 
uh H4; ee. 
nin H4. ee. 
uh H4; uh H5. ee. 
nin H10; nin H15; ee. 

cp H2; cp H3. uh H20; uh H21; ee.
uhg. ee. 
uhg; ee. am. am. am. am. am. 
am. am. 

sh x1. sh x0. 
ee. am. am. 
rw H18. 
uf lf_vertex. 
rw lf_backward_lf_symbol. sy; am. 
rw H16. uf lf_vertex. rw lf_backward_lf_symbol. 
sy; am. 
transitivity (lf_vertex x).
wr H19. rw lf_vertex_lf_extend. tv. am. 
ap is_lf_symbol_lf_symbol. uhg. 
ee; try am. am. am. 
wr H17. 
rw lf_vertex_lf_extend. 
tv. am. ap is_lf_symbol_lf_symbol. uhg. 
ee; try am. am. am. 
transitivity (lf_forward x).
wr H19. rw lf_forward_lf_extend. 
rw lf_forward_lf_symbol. tv. 
wr H17. rw lf_forward_lf_extend. 
rww lf_forward_lf_symbol. 
transitivity (lf_backward x).
wr H19. rw lf_backward_lf_extend. 
rw lf_backward_lf_symbol. tv. 
wr H17. rw lf_backward_lf_extend. 
rw lf_backward_lf_symbol. tv. 
assert (comp a x1 q = lf_backward x).
wr H19. rw lf_backward_lf_extend.
rw lf_backward_lf_symbol. tv. 
rw H28. ap inc_lf_backward. 
sh a; am. 
am. 
ap is_lf_symbol_lf_symbol. uhg. 
ee; try am. uh H2; ee; am. uh H2; ee; am. 
uh H2; ee; am. 
 ap is_lf_symbol_lf_symbol. uhg. 
ee; try am. uh H3; ee; am. uh H3; ee; am. 
uh H3; ee; am. am. am. am. am.
Qed.

Lemma mor_lf_vee_image : forall f p q,
(exists a, exists s, (lf_vee a s p q &
localizes a s f)) -> 
mor (target f) (lf_vee_image f p q).
Proof.
ir. 
nin H. nin H. ee. 
uf lf_vee_image. 
rww mor_comp. 
app mor_inverse. uh H0; ee. ap H3. 
uh H; ee; am. 
app mor_fmor. uh H0; ee; am. 
uh H0; ee. rw H2. uh H; ee; am. 
rw source_inverse. 
uh H0; ee. 
rww target_fmor. rww target_fmor. 
uh H; ee. rww H6. rw H2. uh H; ee; am. 
rw H2. ap inc_ms_mor. uh H; sh x0; ee; am. 
uh H0; ee. ap H3. uh H; ee; am. 
Qed. 

Lemma lf_vee_image_fcompose : forall f g p q,
Functor.axioms f -> Functor.axioms g -> source f = target g ->
mor (source g) p -> mor (source g) q ->
invertible (source f) (fmor g q) -> 
target p = target q -> 
lf_vee_image (fcompose f g) p q =
fmor f (lf_vee_image g p q). 
Proof.
ir. 
assert (mor (source f) (fmor g p)).
rw H1. app  mor_fmor. 
assert (invertible (source f) (fmor g q)).
rw H1. wrr H1. 
assert (mor (source f) (fmor g q)). 
rw H1. app mor_fmor. 

uf lf_vee_image. rw target_fcompose. 
rww fmor_fcompose. 
rww fmor_comp. 
rww fmor_inverse. 
rww fmor_fcompose. 
app mor_inverse. wrr H1. wrr H1. 
rww source_inverse. 
rww target_fmor. rww target_fmor. rww H5. 
wrr H1. 
Qed.

Lemma left_fraction_description_invariant : forall a s f g,
left_fraction_description a s f ->
has_finverse g ->
source g = target f ->
left_fraction_description a s (fcompose g f).
Proof.
ir. 
uh H0; nin H0. 
uh H0; ee. 
assert (Functor.axioms f).
uh H; ee. uh H; ee. am. 


uhg; ee.
ap localizes_fcompose. uh H; ee; am. 
am. am. 
uhg; ee. uhg; ee. app fcompose_axioms. 

ir. rwi source_fcompose H8. rwi source_fcompose H9.
assert (ob_inj f). 
uh H; ee. uh H11; ee; am. 
uh H11; ee. ap H12. am. am. 
transitivity (fob  x (fob (fcompose g f) x0)).
transitivity (fob (fidentity (source g)) (fob f x0)).
rw fob_fidentity. tv. rw H1. app ob_fob. 
wr H6. rw fob_fcompose. rw fob_fcompose. 
tv. am. am. am. am. am. 
am. am. rw H1. app ob_fob. 

rw H10. rw fob_fcompose. 
transitivity (fob (fidentity (source g)) (fob f y)).
wr H6. rw fob_fcompose. tv. am. am. 
am. rw H1. app ob_fob. 
rw fob_fidentity. tv. rw H1. app ob_fob. am. am. 
am. am. 

assert (ob_surj f).
uh H; ee. uh H8; ee; am. uh H8; ee. 
uhg; ee. ap fcompose_axioms. am. am. am. 

ir. rwi target_fcompose H10. 
assert (ob (source x) x0). rww H4. 
uhg. ee. app fcompose_axioms. 
assert (ob (target f) (fob x x0)). wr H1. 
rw H3. app ob_fob. 
cp (H9 _ H12). uh H13. ee. nin H14. 
ee. sh x1. ee. rww source_fcompose. 
rw fob_fcompose. rw H15. wr fob_fcompose.
rw H5. rww fob_fidentity. am. am. 
am. am. am. am. am. am. 


ir. 
rwi target_fcompose H8. 
assert (mor (target f) (fmor x y)).
wr H1. rw H3. app mor_fmor. rww H4. 
uh H; ee. cp (H11 _ H9).
nin H13. nin H13. ee. 

sh x0. sh x1. ee. am. 
rww lf_vee_image_fcompose.
wr H14. 
wr fmor_fcompose. 
rw H5. rww fmor_fidentity. 
rww H4. am. am. am. rww H4. 
uh H; ee. 
rw H16. uh H13; ee; am. 


uf lf_vee_image. 
uh H; ee. 
rw H16. ap inc_ms_mor. 
sh s. ee. am. uh H13; ee; am. rw H1.
uh H; ee. ap H17. uh H13; ee; am. 
uh H13; ee; am. 

assert (lem1 : source f = a).
uh H; ee. uh H; ee. uh H; ee; am. 

ir. 
uh H; ee. 
ap H13. am. am. 
transitivity (fmor x (fmor g (lf_vee_image f p q))).
wrr fmor_fcompose. rw H6. 
rww fmor_fidentity. 
rw H1. ap mor_lf_vee_image. 
sh a; sh s. ee. am. am. 
rw H1. ap mor_lf_vee_image. 
sh a; sh s; ee; am.  


rwi lf_vee_image_fcompose H10. 
rwi lf_vee_image_fcompose H10. 
rw H10. 
wr fmor_fcompose. 
rw H6. rww fmor_fidentity. 
rw H1. ap mor_lf_vee_image. 
sh a; sh s; ee; am.  
am. am. am. 
rw H1. ap mor_lf_vee_image. 
sh a; sh s; ee; am.  
am. am. am. 
rw lem1. uh H9; ee; am. 
rw lem1. ap inc_ms_mor. sh s; ee. 
uh H; ee; am. uh H9; ee; am. 
rw H1. uh H; ee. ap H16. uh H9; ee; am. 
uh H9; ee; am. am. am. am. 
rw lem1. uh H8; ee; am. 
rw lem1. ap inc_ms_mor. sh s; ee.
uh H; ee; am. uh H8; ee; am. 
rw H1. uh H; ee. ap H16.
uh H8; ee; am. uh H8; ee; am. 
Qed.

Lemma left_fraction_description_for_loc : forall a s f,
has_left_fractions a s -> 
is_localization a s f -> 
left_fraction_description a s f.
Proof.
ir. 
assert (f = fcompose (dotted_choice (lf_proj a s) f) (lf_proj a s)).
sy. ap fcompose_dotted_choice. 
sh a. sh s. 
ee. ap is_localization_lf_proj. am. 
uh H0; ee; am. 
rw H1. 
ap left_fraction_description_invariant. 
app left_fraction_description_lf_proj. 
uhg. 
sh (dotted_choice f (lf_proj a s)). 
ap are_finverse_dotted_choice. 
sh a; sh s. ee. 
app is_localization_lf_proj. am. 

rw source_dotted_choice. tv. 
sh a; sh s; ee. 
 app is_localization_lf_proj. 
uh H0; ee; am. 
Qed. 

Lemma left_fraction_description_gz_proj : 
forall a s,
has_left_fractions a s ->
left_fraction_description a s (gz_proj a s).
Proof.
ir. 
ap left_fraction_description_for_loc. am. 
ap is_localization_gz_proj. uh H; ee.
uh H; ee; am. 
Qed. 

Lemma inverse_opp : forall a u,
invertible a (flip u) ->
inverse (opp a) u = flip (inverse a (flip u)).
Proof.
ir. 
uh H; ee. nin H. 
assert (are_inverse (opp a) (flip x) u).
uh H; ee. 
assert (source x = source u).
rwi target_flip H2. am. 
wri mor_opp H. alike. 
assert (target x = target u).
rwi source_flip H1. sy; am. 
wri mor_opp H. alike. 

uhg; dj. 
rw  mor_opp. rww flip_flip. 
rww mor_opp. rw source_flip; try alike. 
rwi source_flip H1; try alike. sy; am. 
rw target_flip; try alike. rwi target_flip H2;
try alike. sy; am. 
rw comp_opp. 
rw flip_flip. rw H3. rw id_opp. 
rww H5. rww ob_source. am. 
am. rw source_flip. am. alike. 

rw comp_opp. rw flip_flip. 
rw H4. rw id_opp. rw H9. rw H1. rww H6. 
rww ob_source. am. am. 
am. 
ap inverse_eq. 
ap are_inverse_symm. 
assert (inverse a (flip u) = x). 
ap inverse_eq. am. 
rw H1. am. 
Qed.


Lemma right_fraction_description_rw : forall a s f,
right_fraction_description a s f =
left_fraction_description (opp a) (oppms s) (oppf f).
Proof.
assert (prop1 : forall a s f,
left_fraction_description a s f ->
right_fraction_description (opp a) (oppms s) (oppf f)).
ir. 
assert (Functor.axioms f).
uh H; ee. uh H; ee. am. 
uh H; ee. 
uhg; ee. 
rw localizes_oppms_oppf. am. 
uhg; ee. 
uhg; ee. ap oppf_axioms. am. 
ir. rwi source_oppf H4. rwi source_oppf H5.
rwi ob_opp H4. rwi ob_opp H5. 
rwi fob_oppf H6. rwi fob_oppf H6. 
uh H1; ee. uh H1; ee. app H8. am. rw source_oppf. rww ob_opp. 
am. am.
rww source_oppf. rww ob_opp. am. am. 

uh H1; ee. 
uh H4; ee. uhg; ee. app oppf_axioms. 
ir. rwi target_oppf H6. rwi ob_opp H6. 
cp (H5 _ H6). uh H7; ee. 
nin H8. ee. uhg; ee. app oppf_axioms. 
sh x0. ee. rww source_oppf. rww ob_opp. 
rww fob_oppf. rww source_oppf. rww ob_opp. 
am. 

ir. rwi target_oppf H4. 
rwi mor_opp H4. 
cp (H2 _ H4). 
nin H5. nin H5. 
ee. sh (flip x). sh (flip x0). 
ee. uhg; ee. 
rw localizing_system_oppms. uh H; ee; am. 
rw mor_opp. rw flip_flip. uh H5; ee; am. 
rw inc_oppms. rw flip_flip. uh H5; ee; am. 
assert (mor a x). uh H5; ee ;am. 
assert (mor a x0). 
ap  inc_ms_mor. sh s. ee. uh H; ee; am. uh H5; ee; am. 

rw source_flip; try alike. 
rw source_flip; try alike. uh H5; ee. am. 

transitivity (flip (flip y)). rww flip_flip. 
rw H6. 
uf lf_vee_image. 
uf rf_wedge_image. 
rw target_oppf. 
rw fmor_oppf. rw fmor_oppf. 
rw comp_opp. rw flip_flip. rw flip_flip. 
rw flip_flip. 
rw inverse_opp.  
rw flip_flip. 
rw flip_flip. reflexivity. 
rw flip_flip. 
uh H; ee. ap H9. uh H5; ee; am. 
rw flip_flip. rw mor_opp. 
rw flip_flip. ap mor_fmor. am. 
uh H; ee. rw H8. uh H5; ee; am. 
rw flip_flip. 
rw inverse_opp. rw flip_flip. 
rw mor_opp. rw flip_flip. 
ap mor_inverse. 
uh H; ee. ap H9. uh H5; ee; am. 
rw flip_flip. 
uh H; ee. ap H9. uh H5; ee; am. 
rw flip_flip. rw flip_flip. 
rw inverse_opp. 
rw flip_flip. 
rw target_flip. 
rw source_inverse. rw source_flip. 
rw target_fmor. rw target_fmor. ap uneq. 
uh H5; ee; am. am. 
uh H; ee. rw H8. 
ap inc_ms_mor. sh s; ee. am. 
uh H5; ee; am. 
am. 
 uh H; ee. rw H8. uh H5; ee; am. 
assert (mor (target f) (fmor f x)).
ap mor_fmor. am. uh H; ee. rw H8. uh H5; ee; am. 
alike. 
uh H; ee. ap H9. uh H5; ee; am. 
assert (mor (target f) (inverse (target f) (fmor f x0))).
ap mor_inverse. 
uh H; ee. ap H9. uh H5; ee; am. 
alike. 
rw flip_flip. 
uh H; ee. ap H9. uh H5; ee; am. 
am. rw source_oppf. rw mor_opp. rw flip_flip.
uh H; ee. rw H8. 
ap inc_ms_mor. sh s; ee. am. 
uh H5; ee; am. 
am. am. 
rw source_oppf. rw mor_opp. rw flip_flip.
 uh H; ee. rw H8. uh H5; ee; am. 
am. am. am. 

ir. 
uh H4; uh H5; ee.
cp H. uh H; ee. 

assert (mor a (flip p)).
wrr mor_opp. 

assert (inc (flip q) s).
wrr inc_oppms.  

assert (mor a (flip q)).
ap inc_ms_mor. sh s; ee; am. 

assert (mor (opp a) q).
ap inc_ms_mor. sh (oppms s); ee; am. 


assert (target (flip p) = target (flip q)).
rw target_flip; try alike. 
rw target_flip; try alike. am. 

assert (mor a (flip r)).
wrr mor_opp. 

assert (inc (flip t) s).
wrr inc_oppms.  

assert (mor a (flip t)).
ap inc_ms_mor. sh s; ee; am. 

assert (mor (opp a) t).
ap inc_ms_mor. sh (oppms s); ee; am. 


assert (target (flip r) = target (flip t)).
rw target_flip; try alike. 
rw target_flip; try alike. am. 



assert (lf_vee a s (flip p) (flip q)).
uhg; ee; try am. 

assert (lf_vee a s (flip r) (flip t)).
uhg; ee; try am. 

assert (invertible (target f) (fmor f (flip q))).
uh H; ee. ap H16. am. 

assert (sfa : source f = a).
uh H; ee; am. 

assert (rf_wedge_image (oppf f) p q =
flip (lf_vee_image f (flip p) (flip q))).
uf rf_wedge_image. 
uf lf_vee_image. 
rw target_oppf. rw comp_opp. 
rw fmor_oppf. rw fmor_oppf. 
rw flip_flip. 
rw inverse_opp. rw flip_flip. rw flip_flip. 
tv. 
rw flip_flip. 
am. am. rw source_oppf. rw sfa. am. am. 
am. rw source_oppf. rw sfa. am. am. 
rw mor_opp. rw fmor_oppf. 
rw flip_flip. ap mor_fmor. am.
rw sfa. am. am. 
rw source_oppf. rw sfa. am. am. 
rw inverse_opp. 
rw mor_opp. rw flip_flip. 
rw fmor_oppf. rw flip_flip. 
ap mor_inverse. am. am. 
rw source_oppf. rww sfa. am. 
rw fmor_oppf. rw flip_flip. am. 
am.  rw source_oppf. rww sfa.
am. 
rw target_inverse. 
rw fmor_oppf. 
rw fmor_oppf. 
rw source_flip. rw source_flip. 
rw target_fmor. rw target_fmor. rww H21. 
am. rww sfa. am. 
rww sfa. assert (mor (target f) (fmor f (flip q))).
ap mor_fmor. am. rww sfa. 
alike. 
assert (mor (target f) (fmor f (flip p))).
ap mor_fmor. am. rww sfa. 
alike. 
am. 
rw source_oppf. rww sfa.
am. am. 
rw source_oppf. rww sfa.
am. 
rw fmor_oppf. 
rw invertible_opp. am. am. 
rw source_oppf. rww sfa.
am. am. 
 

assert (invertible (target f) (fmor f (flip t))).
uh H; ee. ap H16. am. 

assert (rf_wedge_image (oppf f) r t =
flip (lf_vee_image f (flip r) (flip t))).
uf rf_wedge_image. 
uf lf_vee_image. 
rw target_oppf. rw comp_opp. 
rw fmor_oppf. rw fmor_oppf. 
rw flip_flip. 
rw inverse_opp. rw flip_flip. rw flip_flip. 
reflexivity. 

rw flip_flip. 
am. am. rw source_oppf. rw sfa. am. am. 
am. rw source_oppf. rw sfa. am. am. 
rw mor_opp. rw fmor_oppf. 
rw flip_flip. ap mor_fmor. am.
rw sfa. am. am. 
rw source_oppf. rw sfa. am. am. 
rw inverse_opp. 
rw mor_opp. rw flip_flip. 
rw fmor_oppf. rw flip_flip. 
ap mor_inverse. am. am. 
rw source_oppf. rww sfa. am. 
rw fmor_oppf. rw flip_flip. am. 
am.  rw source_oppf. rww sfa.
am. 
rw target_inverse. 
rw fmor_oppf. 
rw fmor_oppf. 
rw source_flip. rw source_flip. 
rw target_fmor. rw target_fmor. rww H26. 
am. rww sfa. am. 
rww sfa. assert (mor (target f) (fmor f (flip t))).
ap mor_fmor. am. rww sfa. 
alike. 
assert (mor (target f) (fmor f (flip r))).
ap mor_fmor. am. rww sfa. 
alike. 
am. 
rw source_oppf. rww sfa.
am. am. 
rw source_oppf. rww sfa.
am. 
rw fmor_oppf. 
rw invertible_opp. am. am. 
rw source_oppf. rww sfa.
am. am. 
 

assert (lf_vee_equivalent a s (flip p) (flip q)
(flip r) (flip t)).
ap H3. am. am. 
transitivity (flip (flip (lf_vee_image f (flip p) (flip q)))).
rww flip_flip. 
wr H30. rw H6. rw H32. rww flip_flip. 


uh H33; ee. 
nin H37. nin H37. 
ee. 

cp H35; cp H36. rwi source_flip H45. 
rwi source_flip H45. 
rwi source_flip H46. rwi source_flip H46. 


uhg; ee.
uhg; ee; am. uhg; ee; am. 
am. am. 

sh (flip x). 
sh (flip x0). 
ee. 
rw mor_opp. rww flip_flip. 
rw mor_opp. rww flip_flip. 
rw target_flip. rwi target_flip H39. am. alike. alike.
rw target_flip; try alike. 
rwi target_flip H40; try alike. am. 
rw source_flip; try alike. 
rw source_flip; try alike. am. 

rw comp_opp. rw comp_opp. 
rw flip_flip. rw flip_flip. rw H42. 
reflexivity. am. rw mor_opp. rww flip_flip. 
rw target_flip; try alike. 
rwi target_flip H40; try alike. sy; am. 
am. rw mor_opp. rww flip_flip. 
rw target_flip; try alike. 
rwi target_flip H39; try alike. sy; am. 

rw comp_opp. rw comp_opp. 
rw flip_flip. rw flip_flip. rw H43. 
reflexivity. am. rw mor_opp. rww flip_flip. 
rw target_flip; try alike. 
rwi target_flip H40; try alike. rw H40. sy; am. 
am. rw mor_opp. rww flip_flip. 
rw target_flip; try alike. 
rwi target_flip H39; try alike. rw H39. sy; am. 

rw inc_oppms. 
rw comp_opp. 
rw flip_flip. rw flip_flip. am. am. 
rw mor_opp. rww flip_flip. 
rw target_flip; try alike. 
rwi target_flip H39; try alike. rw H39. sy; am. 
alike. alike. alike. alike. 

assert (prop2 : forall a s f,
right_fraction_description a s f ->
left_fraction_description (opp a) (oppms s) (oppf f)).

(** We try just to recopy the proof of the previous
assertion and change as little as possible **)

ir. 
assert (Functor.axioms f).
uh H; ee. uh H; ee. am. 
uh H; ee. 
uhg; ee. 
rw localizes_oppms_oppf. am. 
uhg; ee. 
uhg; ee. ap oppf_axioms. am. 
ir. rwi source_oppf H4. rwi source_oppf H5.
rwi ob_opp H4. rwi ob_opp H5. 
rwi fob_oppf H6. rwi fob_oppf H6. 
uh H1; ee. uh H1; ee. app H8. am. rw source_oppf. rww ob_opp. 
am. am.
rww source_oppf. rww ob_opp. am. am. 

uh H1; ee. 
uh H4; ee. uhg; ee. app oppf_axioms. 
ir. rwi target_oppf H6. rwi ob_opp H6. 
cp (H5 _ H6). uh H7; ee. 
nin H8. ee. uhg; ee. app oppf_axioms. 
sh x0. ee. rww source_oppf. rww ob_opp. 
rww fob_oppf. rww source_oppf. rww ob_opp. 
am. 

ir. rwi target_oppf H4. 
rwi mor_opp H4. 
cp (H2 _ H4). 
nin H5. nin H5. 
ee. sh (flip x). sh (flip x0). 
ee. uhg; ee. 
rw localizing_system_oppms. uh H; ee; am. 
rw mor_opp. rw flip_flip. 

uh H5; ee; am. 
rw inc_oppms. rw flip_flip. uh H5; ee; am. 
assert (mor a x). uh H5; ee ;am. 
assert (mor a x0). 
ap  inc_ms_mor. sh s. ee. uh H; ee; am. uh H5; ee; am. 

rw target_flip; try alike. 
rw target_flip; try alike. uh H5; ee. am. 

transitivity (flip (flip y)). rww flip_flip. 
rw H6. 
uf lf_vee_image. 
uf rf_wedge_image. 
rw target_oppf. 
rw fmor_oppf. rw fmor_oppf. 
rw comp_opp. rw flip_flip. rw flip_flip. 
rw flip_flip. 
rw inverse_opp.  
rw flip_flip. 
rw flip_flip. reflexivity. 
rw flip_flip. 
uh H; ee. ap H9. uh H5; ee; am. 
rw flip_flip. 
rw inverse_opp. rw flip_flip. 
rw mor_opp. rw flip_flip. 
ap mor_inverse. 
uh H; ee. ap H9. uh H5; ee; am. 
rw flip_flip. 
uh H; ee. ap H9. uh H5; ee; am. 
rw flip_flip. 
rw mor_opp. 
rw flip_flip. ap mor_fmor. am. 
uh H; ee. rw H8. uh H5; ee; am. 
rw flip_flip. rw flip_flip. 
rw inverse_opp. 
rw flip_flip. 
rw source_flip. 
rw target_inverse. rw target_flip. 
rw source_fmor. rw source_fmor. ap uneq. 
uh H5; ee; sy; am. am. 
uh H; ee. rw H8. 
uh H5; ee. am. 
am. 
 uh H; ee. rw H8. ap inc_ms_mor.
sh s; ee. am. uh H5; ee; am. 
assert (mor (target f) (fmor f x)).
ap mor_fmor. am. uh H; ee. rw H8. uh H5; ee; am. 
alike. 
uh H; ee. ap H9. uh H5; ee; am. 
assert (mor (target f) (inverse (target f) (fmor f x0))).
ap mor_inverse. 
uh H; ee. ap H9. uh H5; ee; am. 
alike. 
rw flip_flip. 
uh H; ee. ap H9. uh H5; ee; am. 
am. rw source_oppf. rw mor_opp. rw flip_flip.
uh H; ee. rw H8. 
uh H5; ee; am. am. am. 
rw source_oppf. rw mor_opp. rw flip_flip.
 uh H; ee. rw H8. ap inc_ms_mor. 
sh s; ee. am. uh H5; ee; am. 
am. am. am. 

ir. 
uh H4; uh H5; ee.
cp H. uh H; ee. 

assert (mor a (flip p)).
wrr mor_opp. 

assert (inc (flip q) s).
wrr inc_oppms.  

assert (mor a (flip q)).
ap inc_ms_mor. sh s; ee; am. 

assert (mor (opp a) q).
ap inc_ms_mor. sh (oppms s); ee; am. 


assert (source (flip p) = source (flip q)).
rw source_flip; try alike. 
rw source_flip; try alike. am. 

assert (mor a (flip r)).
wrr mor_opp. 

assert (inc (flip t) s).
wrr inc_oppms.  

assert (mor a (flip t)).
ap inc_ms_mor. sh s; ee; am. 

assert (mor (opp a) t).
ap inc_ms_mor. sh (oppms s); ee; am. 


assert (source (flip r) = source (flip t)).
rw source_flip; try alike. 
rw source_flip; try alike. am. 



assert (rf_wedge a s (flip p) (flip q)).
uhg; ee; try am. 

assert (rf_wedge a s (flip r) (flip t)).
uhg; ee; try am. 

assert (invertible (target f) (fmor f (flip q))).
uh H; ee. ap H16. am. 

assert (sfa : source f = a).
uh H; ee; am. 

assert (lf_vee_image (oppf f) p q =
flip (rf_wedge_image f (flip p) (flip q))).
uf rf_wedge_image. 
uf lf_vee_image. 
rw target_oppf. rw comp_opp. 
rw fmor_oppf. rw fmor_oppf. 
rw flip_flip. 
rw inverse_opp. rw flip_flip. rw flip_flip. 
tv. 
rw flip_flip. 
am. am. rw source_oppf. rw sfa. am. am. 
am. rw source_oppf. rw sfa. am. am. 
rw inverse_opp. 
rw mor_opp. rw flip_flip. 
rw fmor_oppf. rw flip_flip. 
ap mor_inverse. am. am. 
rw source_oppf. rww sfa. am. 
rw fmor_oppf. rw flip_flip. am. 
am.  rw source_oppf. rww sfa.
am. 




rw mor_opp. rw fmor_oppf. 
rw flip_flip. ap mor_fmor. am.
rw sfa. am. am. 
rw source_oppf. rw sfa. am. am. 

rw source_inverse. 
rw fmor_oppf. 
rw fmor_oppf. 
rw target_flip. rw target_flip. 
rw source_fmor. rw source_fmor. rww H21. 
am. rww sfa. am. 
rww sfa. assert (mor (target f) (fmor f (flip p))).
ap mor_fmor. am. rww sfa. 
alike. 
assert (mor (target f) (fmor f (flip q))).
ap mor_fmor. am. rww sfa. 
alike. 
am. 
rw source_oppf. rww sfa.
am. am. 
rw source_oppf. rww sfa.
am. 
rw fmor_oppf. 
rw invertible_opp. am. am. 
rw source_oppf. rww sfa.
am. am. 
 

assert (invertible (target f) (fmor f (flip t))).
uh H; ee. ap H16. am. 

assert (lf_vee_image (oppf f) r t =
flip (rf_wedge_image f (flip r) (flip t))).
uf rf_wedge_image. 
uf lf_vee_image. 
rw target_oppf. rw comp_opp. 
rw fmor_oppf. rw fmor_oppf. 
rw flip_flip. 
rw inverse_opp. rw flip_flip. rw flip_flip. 
reflexivity. 

rw flip_flip. 
am. am. rw source_oppf. rw sfa. am. am. 
am. rw source_oppf. rw sfa. am. am. 
rw inverse_opp. 
rw mor_opp. rw flip_flip. 
rw fmor_oppf. rw flip_flip. 
ap mor_inverse. am. am. 
rw source_oppf. rww sfa. am. 
rw fmor_oppf. rw flip_flip. am. 
am.  rw source_oppf. rww sfa.
am. 


rw mor_opp. rw fmor_oppf. 
rw flip_flip. ap mor_fmor. am.
rw sfa. am. am. 
rw source_oppf. rw sfa. am. am. 

rw source_inverse. 
rw fmor_oppf. 
rw fmor_oppf. 
rw target_flip. rw target_flip. 
rw source_fmor. rw source_fmor. rww H26. 
am. rww sfa. am. 
rww sfa. assert (mor (target f) (fmor f (flip r))).
ap mor_fmor. am. rww sfa. 
alike. 
assert (mor (target f) (fmor f (flip t))).
ap mor_fmor. am. rww sfa. 
alike. 
am. 
rw source_oppf. rww sfa.
am. am. 
rw source_oppf. rww sfa.
am. 
rw fmor_oppf. 
rw invertible_opp. am. am. 
rw source_oppf. rww sfa.
am. am. 
 

assert (rf_wedge_equivalent a s (flip p) (flip q)
(flip r) (flip t)).
ap H3. am. am. 
transitivity (flip (flip (rf_wedge_image f (flip p) (flip q)))).
rww flip_flip. 
wr H30. rw H6. rw H32. rww flip_flip. 


uh H33; ee. 
nin H37. nin H37. 
ee. 

cp H35; cp H36. rwi target_flip H45. 
rwi target_flip H45. 
rwi target_flip H46. rwi target_flip H46. 


uhg; ee.
uhg; ee; am. uhg; ee; am. 
am. am. 

sh (flip x). 
sh (flip x0). 
ee. 
rw mor_opp. rww flip_flip. 
rw mor_opp. rww flip_flip. 
rw source_flip. rwi source_flip H39. am. alike. alike.
rw source_flip; try alike. 
rwi source_flip H40; try alike. am. 
rw target_flip; try alike. 
rw target_flip; try alike. am. 

rw comp_opp. rw comp_opp. 
rw flip_flip. rw flip_flip. rw H42. 
reflexivity. rw mor_opp. rww flip_flip. am. 
rw source_flip; try alike. 
rwi source_flip H40; try alike. am. 
rw mor_opp. rww flip_flip. am. 
rw source_flip; try alike. 
rwi source_flip H39; try alike. am. 

rw comp_opp. rw comp_opp. 
rw flip_flip. rw flip_flip. rw H43. 
reflexivity. rw mor_opp. rww flip_flip. am. 
rw source_flip; try alike. 
rwi source_flip H40; try alike. rw H40. am. 
rw mor_opp. rww flip_flip. am. 
rw source_flip; try alike. 
rwi source_flip H39; try alike. rw H39. am. 

rw inc_oppms. 
rw comp_opp. 
rw flip_flip. rw flip_flip. am. 
rw mor_opp. rww flip_flip. am. 
rw source_flip; try alike. 
rwi source_flip H39; try alike. rw H39. am. 
alike. alike. alike. alike. 

(*** Whew! Now we can easily finish the proof using
[prop1] and [prop2]. ***)

ir. 
ap iff_eq; ir. 
ap prop2. am. 

assert (a = opp (opp a)).
rww opp_opp. 
assert (s = oppms (oppms s)).
rww oppms_oppms. 
assert (f = oppf (oppf f)).
rww oppf_oppf. 

rw H0; rw H1; rw H2. 
ap prop1. am.  
Qed.

Lemma right_fraction_description_for_loc : forall a s f,
has_right_fractions a s -> 
is_localization a s f -> 
right_fraction_description a s f.
Proof.
ir. 
rw right_fraction_description_rw. 
ap left_fraction_description_for_loc. 
wr has_right_fractions_rw. 
am. 
rw is_localization_oppms_oppf. am. 
Qed. 

Lemma right_fraction_description_gz_proj : forall a s,
has_right_fractions a s ->
right_fraction_description a s (gz_proj a s).
Proof.
ir. ap right_fraction_description_for_loc. 
am. ap is_localization_gz_proj. 
uh H; ee. uh H; ee; am. 
Qed. 

(** Given the explicit construction of [gz_loc a s] 
and the functor [gz_proj a s] via the quotient of a free
category by a list of relations, the theorems
[left_fraction_description_gz_proj] and 
[right_fraction_description_gz_proj] are nontrivial theorems
with a nice proof as indicated in Gabriel-Zisman which
we have now checked formally. ***)


End GZ_Localization. 

(*****************************************************************************************)
(*****************************************************************************************)
(*****************************************************************************************)
(*****************************************************************************************)


(** we could put this in update_for_gz.v **)
Module Coarse_Cat.
Export GZ_Localization.
Export Infinite.

Definition null_arrow a b := Arrow.create a b emptyset.

Lemma source_null_arrow : forall a b, source (null_arrow a b) = a.
Proof.
ir. 
uf null_arrow. rww Arrow.source_create.
Qed.

Lemma target_null_arrow : forall a b, target (null_arrow a b) = b.
Proof.
ir. 
uf null_arrow. rww Arrow.target_create.
Qed.

Lemma arrow_null_arrow : forall a b, 
arrow (null_arrow a b) = emptyset.
Proof.
ir. 
uf null_arrow. rww Arrow.arrow_create.
Qed.

Definition na_comp u v := null_arrow (source v) (target u).

Lemma source_na_comp : forall u v, source (na_comp u v) = source v.
Proof.
ir. 
uf na_comp. rww source_null_arrow.
Qed.

Lemma target_na_comp : forall u v, target (na_comp u v) = target u.
Proof.
ir. uf na_comp. rww target_null_arrow.
Qed.

Definition is_null_arrow u := u = null_arrow (source  u) (target u).

Lemma is_null_arrow_null_arrow : forall a b,
is_null_arrow (null_arrow a b).
Proof.
ir. 
uhg. 
rw source_null_arrow; rww target_null_arrow.
Qed.

Lemma is_null_arrow_na_comp : forall u v,
is_null_arrow (na_comp u v).
Proof.
ir. uf na_comp. ap is_null_arrow_null_arrow.
Qed.

Lemma null_arrow_extensionality : forall a b,
is_null_arrow a -> is_null_arrow b ->
source a = source b -> target a = target b -> a = b.
Proof.
ir.
uh H; uh H0. rw H. rw H0. 
rw H1; rww H2. 
Qed.

Lemma na_comp_assoc : forall a b c,
na_comp (na_comp a b) c = na_comp a (na_comp b c).
Proof.
ir. 
ap null_arrow_extensionality.
ap is_null_arrow_na_comp. 
ap is_null_arrow_na_comp. 
rw source_na_comp. rw source_na_comp. rww source_na_comp.
rw target_na_comp; rw target_na_comp; rww target_na_comp.
Qed.

Lemma na_comp_null_arrow : forall a b c d,
na_comp (null_arrow a b) (null_arrow c d) =
null_arrow c b.
Proof.
ir.
ap null_arrow_extensionality.
ap is_null_arrow_na_comp.
ap  is_null_arrow_null_arrow.
rw source_na_comp. rw source_null_arrow. rww source_null_arrow.
rw target_na_comp. rw target_null_arrow. rww target_null_arrow.
Qed.


Lemma na_left_id : forall a u,
is_null_arrow a -> 
u = null_arrow (target a) (target a) ->
na_comp u a = a.
Proof.
ir.
ap null_arrow_extensionality.
ap is_null_arrow_na_comp.
am. 
rww source_na_comp. 
rww target_na_comp. rw H0. rww target_null_arrow.
Qed.

Lemma na_right_id : forall a u,
is_null_arrow a -> 
u = null_arrow (source a) (source a) ->
na_comp a u = a.
Proof.
ir.
ap null_arrow_extensionality.
ap is_null_arrow_na_comp.
am. 
rww source_na_comp. rw H0. rww source_null_arrow.
rww target_na_comp. 
Qed.

 
Definition coarse_arrows z :=
Image.create (product z z) 
(fun x => null_arrow (pr1 x) (pr2 x)).

Lemma inc_coarse_arrows : forall u z,
inc u (coarse_arrows z) = 
(is_null_arrow u & inc (source u) z & inc (target u) z).
Proof.
ir. 
ap iff_eq; ir.
ufi coarse_arrows H.
rwi Image.inc_rw H. 
nin H.
ee.
wr H0; ap is_null_arrow_null_arrow.
wr H0. rw source_null_arrow.
rwi inc_product H; ee; am. 
wr H0. rw target_null_arrow.
rwi inc_product H; ee; am. 

uf coarse_arrows.
rw Image.inc_rw. 
sh (pair (source u) (target u)).
ee.
rw inc_product. 
ee. ap pair_is_pair.
rw pr1_pair. am. rww pr2_pair. 
rw pr1_pair. rw pr2_pair. uh H; sy; am. 
Qed.

Definition coarse_cat z :=
Category.Notations.create z (coarse_arrows z) 
na_comp (fun x => null_arrow x x) emptyset.

Lemma is_ob_coarse_cat : forall x z, 
is_ob (coarse_cat z) x = inc x z.
Proof.
ir. 
uf coarse_cat. rww is_ob_create. 
Qed.

Lemma is_mor_coarse_cat : forall u z, 
is_mor (coarse_cat z) u  = 
(is_null_arrow u & inc (source u) z & inc (target u) z).
Proof.
ir. 
uf coarse_cat.
rw is_mor_create. rww inc_coarse_arrows. 
Qed.

Lemma comp_coarse_cat1 : forall u v z,
is_mor (coarse_cat z) u -> is_mor (coarse_cat z) v ->
source u = target v ->
comp (coarse_cat z) u v = na_comp u v.
Proof.
ir. 
uf coarse_cat. 
rwi is_mor_coarse_cat H.
rwi is_mor_coarse_cat H0.

rww comp_create.  

rw inc_coarse_arrows. ee; try am. 
rw inc_coarse_arrows. ee; try am. 
Qed.

Lemma id_coarse_cat : forall x z,
inc x z -> id (coarse_cat z) x = null_arrow x x.
Proof.
ir. 
uf coarse_cat. rww id_create.
Qed.

Lemma coarse_cat_axioms : forall z,
Category.axioms (coarse_cat z). 
Proof.
ir. 
uf coarse_cat. 
ap Category.create_axioms. 
uhg; ee; ir. 
ap iff_eq; ir. 
uhg. ee. am. 
rw inc_coarse_arrows. ee. 
ap is_null_arrow_null_arrow. 
rww source_null_arrow. rww target_null_arrow.
rww source_null_arrow. rww target_null_arrow. 
uh H; ee; am. 

ap iff_eq; ir. 
rwi inc_coarse_arrows H; ee. 
uhg; ee. rw inc_coarse_arrows; ee; am. 
am. am. 
uh H; rw H. 
rw source_null_arrow. rww na_comp_null_arrow.
uh H; rw H. 
rw target_null_arrow. rww na_comp_null_arrow.
uh H; rw H. 
uf null_arrow. rww Arrow.create_like.
uh H; ee; am. 

cp H; cp H0. 
rwi inc_coarse_arrows H; rwi inc_coarse_arrows H0; ee.
uhg; ee. am. am. am. 
rw inc_coarse_arrows. ee.
ap is_null_arrow_na_comp. rww source_na_comp. 
rww target_na_comp. 
rww source_na_comp. rww target_na_comp. 
rww na_comp_assoc. 
Qed.

Lemma ob_coarse_cat : forall x z,
ob (coarse_cat z) x = inc x z.
Proof.
ir.
ap iff_eq; ir. 
uh H. ee.
rwi is_ob_coarse_cat H0; am. 
ap is_ob_ob. ap coarse_cat_axioms. 
rww is_ob_coarse_cat. 
Qed.

Lemma  mor_coarse_cat : forall u z,
mor (coarse_cat z) u = 
(is_null_arrow u & inc (source u) z & inc (target u) z).
Proof.
ir. 
transitivity (is_mor (coarse_cat z) u).
ap iff_eq; ir.
app mor_is_mor. 
app is_mor_mor. ap coarse_cat_axioms. 
rww is_mor_coarse_cat. 
Qed.

Lemma comp_coarse_cat : forall u v z,
mor (coarse_cat z) u -> mor (coarse_cat z) v ->
source u = target v ->
comp (coarse_cat z) u v = na_comp u v.
Proof.
ir. 
rww comp_coarse_cat1. 
app mor_is_mor.  
app mor_is_mor.  
Qed.

End Coarse_Cat.

Module Lf_Counterexample.
Export Coarse_Cat. 
Export Left_Fraction_Category.

Inductive cx_ob : E -> Prop :=
is0 : cx_ob (R 0) |
is1 : cx_ob (R 1) |
is2 : cx_ob (R 2).

Ltac is_cx_ob :=
match goal with 
| |- cx_ob (R 0) => ap is0
| |- cx_ob (R 1) => ap is1
| |- cx_ob (R 2) => ap is2
| _ => fail end.


Lemma cx_ob_rw : forall x,
cx_ob x = inc x (R 3).
Proof.
ir. 
ap iff_eq; ir.
nin H; rw inc_lt; om. 

rwi R_S_tack_on H; rwi tack_on_inc H. nin H.  
rwi R_S_tack_on H; rwi tack_on_inc H. nin H. 
rwi R_S_tack_on H; rwi tack_on_inc H. nin H. 
rwi zero_emptyset H. 
nin H. nin x0. 
rw H; is_cx_ob. rw H; is_cx_ob. rw H; is_cx_ob.
Qed.

Notation na00 := (null_arrow (R 0) (R 0)).
Notation na11 := (null_arrow (R 1) (R 1)).
Notation na22 := (null_arrow (R 2) (R 2)).

Notation na01 := (null_arrow (R 0) (R 1)).
Notation na02 := (null_arrow (R 0) (R 2)).

Notation na12 := (null_arrow (R 1) (R 2)).
Notation na21 := (null_arrow (R 2) (R 1)).

Inductive cx_mor : E -> Prop :=
is00 :  cx_mor na00 |
is11 : cx_mor na11 |
is22 : cx_mor na22 |
is01 : cx_mor na01 |
is02 : cx_mor na02 |
is12 : cx_mor na12 |
is21 : cx_mor na21 .

Ltac is_cx_mor :=
match goal with 
| |- cx_mor na00 => ap is00
| |- cx_mor na11 => ap is11 
| |- cx_mor na22 => ap is22 
| |- cx_mor na01 => ap is01 
| |- cx_mor na02 => ap is02 
| |- cx_mor na12 => ap is12 
| |- cx_mor na21 => ap is21 
| _ => fail end. 
 


Lemma cx_mor_mor : forall u, cx_mor u -> 
mor (coarse_cat (R 3)) u.
Proof.
ir. 
rw mor_coarse_cat. ee. 
nin H; ap is_null_arrow_null_arrow. 
wr cx_ob_rw. 
nin H; rw source_null_arrow; is_cx_ob.  
wr cx_ob_rw.
nin H; rw target_null_arrow; is_cx_ob. 
Qed.



Definition cx := subcategory (coarse_cat (R 3))
cx_ob cx_mor.

Ltac R_nat_discriminate :=
match goal with 
| id1 : R ?X1 = R ?X2 |- _ => 
assert (discr : X1 = X2); [app R_inj | discriminate discr]
| _ => fail
end.


Lemma cx_property : subcategory_property (coarse_cat (R 3))
cx_ob cx_mor.
Proof.
ir. 
uhg; ee; ir. 
ap coarse_cat_axioms. rw comp_coarse_cat.

nin H2; nin H3; 
try (rwi source_null_arrow H1; rwi target_null_arrow H1; 
R_nat_discriminate);  try 
(rw na_comp_null_arrow; is_cx_mor).
app cx_mor_mor. app cx_mor_mor. am. 
rw id_coarse_cat. 
nin H0; is_cx_mor. 
wrr cx_ob_rw. 
nin H0; rw source_null_arrow; is_cx_ob. 
nin H0; rw target_null_arrow; is_cx_ob. 
Qed. 

Lemma cx_axioms : Category.axioms cx.
Proof.
ir. 
unfold cx. 
ap subcategory_axioms. 
ap cx_property. 
Qed. 

Lemma ob_cx : forall x, ob cx x = cx_ob x.
Proof.
ir.
unfold cx. rw ob_subcategory.
ap iff_eq; ir.
ee; am. ee.
rw ob_coarse_cat. rwi cx_ob_rw H. am. am. 
ap cx_property. 
Qed. 

Lemma mor_cx : forall u, mor cx u = cx_mor u.
Proof.
ir.
unfold cx. rw mor_subcategory.
ap iff_eq; ir.
ee; am. ee.
app cx_mor_mor. am. 
ap cx_property. 
Qed. 

Inductive in_cx_sys : E -> Prop :=
sys00 : in_cx_sys na00 |
sys11 : in_cx_sys na11 |
sys22 : in_cx_sys na22 |
sys01 : in_cx_sys na01 |
sys02 : in_cx_sys na02.

Ltac is_cx_sys := 
match goal with 
| |- in_cx_sys na00 => ap sys00
| |- in_cx_sys na11 => ap sys11
| |- in_cx_sys na22 => ap sys22
| |- in_cx_sys na01 => ap sys01
| |- in_cx_sys na02 => ap sys02
| _ => fail end. 


Definition cx_sys := Z (morphisms cx) in_cx_sys.

Lemma inc_cx_sys : forall u,
inc u cx_sys = in_cx_sys u.
Proof.
ir.
ap iff_eq; ir.
ufi cx_sys H. Ztac. 
uf cx_sys.
ap Z_inc.
ap mor_is_mor.
rw mor_cx. nin H; is_cx_mor.
am. 
Qed.

Lemma source_null_arrow_eq : forall a b c d,
null_arrow a b = null_arrow c d -> a = c.
Proof.
ir.
transitivity (source (null_arrow a b)).
rww source_null_arrow.
rw H. rww source_null_arrow.
Qed. 

Lemma target_null_arrow_eq : forall a b c d,
null_arrow a b = null_arrow c d -> b = d.
Proof.
ir.
transitivity (target (null_arrow a b)).
rww target_null_arrow.
rw H. rww target_null_arrow.
Qed. 

Lemma cx_sys_rw : forall u,
inc u cx_sys = (in_cx_sys u &
mor cx u & cx_mor u & ~u=na12 & ~u=na21).
Proof.
ir.
ap iff_eq; ir.
rwi inc_cx_sys H.
ee; try am. 
rw mor_cx.  
nin H; is_cx_mor. 
nin H; is_cx_mor. 
uhg; ir.
nin H; 
cp (source_null_arrow_eq H0);
cp (target_null_arrow_eq H0);
R_nat_discriminate. 

uhg; ir.
nin H; 
cp (source_null_arrow_eq H0);
cp (target_null_arrow_eq H0);
R_nat_discriminate. 

rw inc_cx_sys;
ee; am. 
Qed.

Lemma comp_cx : forall u v,
mor cx u -> mor cx v -> source u = target v ->
comp cx u v = na_comp u v.
Proof.
ir.
unfold cx. 
rw comp_subcategory. rw comp_coarse_cat.
tv. ap cx_mor_mor.
rwi mor_cx H; am. 
ap cx_mor_mor.
rwi mor_cx H0; am. am. 
ap cx_property. 
ap cx_mor_mor.
rwi mor_cx H; am. 
ap cx_mor_mor.
rwi mor_cx H0; am. am. 
rwi mor_cx H; am. 
rwi mor_cx H0; am. 
Qed.


Lemma id_cx : forall x,
ob cx x -> id cx x = null_arrow x x.
Proof.
ir. 
unfold cx. 
rw id_subcategory. 
rw id_coarse_cat. tv. 
rwi ob_cx H. wrr cx_ob_rw. 
ap cx_property. 
rw ob_coarse_cat. wrr cx_ob_rw. 
wrr ob_cx. wrr ob_cx. 
Qed.

Lemma localizing_system_cx_sys: 
localizing_system cx cx_sys.
Proof.
uhg; ee. ap cx_axioms. 
ir. 
rwi cx_sys_rw H. ee; am.  
Qed. 

Lemma multiplicative_system_cx_sys: 
multiplicative_system cx cx_sys.
Proof.
uhg; ee. 
ap localizing_system_cx_sys.
ir. 
rwi cx_sys_rw H; rwi cx_sys_rw H0; ee.
rww comp_cx. 
rw inc_cx_sys.
nin H7; nin H3; 
try (rwi source_null_arrow H1; rwi target_null_arrow H1;
R_nat_discriminate);
try (rw na_comp_null_arrow;
is_cx_sys).

assert False.
app H5. elim H3.

assert False.
app H4. elim H3.

assert False.
app H8. elim H3.

assert False.
app H9. elim H3.
Qed. 

Lemma has_left_fractions_cx_sys : 
has_left_fractions cx cx_sys.
Proof.
(** in order to avoid [lf_symbol] and other specific
notations we rewrite as per the lemma in [gzloc.v]. **)
rw has_left_fractions_rw.
ee.
ap multiplicative_system_cx_sys.

ir.
rw id_cx. rwi ob_cx H. 
rw inc_cx_sys. 
nin H; is_cx_sys. am. 

ir.
apply by_cases with 
((r = id cx (source r)) \/ 
(g = id cx (source g))). 


(** the case [r = id cx (source r)] **)
ir; nin H2.
sh g. 
sh (id cx (target g)).

ee. 
am. 
rw id_cx. 
rw inc_cx_sys. 
rwi mor_cx H0. nin H0; 
rw target_null_arrow; 
is_cx_sys. 
rww ob_target. 
rww target_id. 
rww ob_target. rw H2. 

rww target_id. 
sy; am. rww ob_source. 
rwi cx_sys_rw H; ee; am. 
rww source_id. rww ob_target. 
rww left_id. 
rw H2. rw H1. rww right_id. 
rww ob_source. rww ob_target. 

(** the case [g = id cx (source g)] **)
rwi cx_sys_rw H. 
ee. 
sh (id cx (target r)).
sh r. 
ee.
ap mor_id. rww ob_target. rww inc_cx_sys. 
rww target_id. rww ob_target. 
rww source_id. rww ob_target. 
rw H2. rww target_id. 
rww ob_source. 
rww left_id. rw H2. wr H1.
rww right_id. rww ob_source. rww ob_target. 

(** now we try to eliminate most other cases **)
ir. 

apply by_cases with (r=na01 \/ r = na02); ir.

apply by_cases with (g = na01 \/ g = na02); ir.

nin H3; nin H4; rw H3; rw H4.

(** the case [r = na01] and [g = na01] **)
sh (null_arrow (R 1) (R 1)).
sh (null_arrow (R 1) (R 1)).
ee.
rw mor_cx. is_cx_mor. 
rw inc_cx_sys. is_cx_sys. tv. 
rw source_null_arrow; rww target_null_arrow.
rw source_null_arrow; rww target_null_arrow.
tv. 

(** the case [r = na01] and [g = na02] **)
sh (null_arrow (R 1) (R 2)).
sh (null_arrow (R 2) (R 2)).
ee.
rw mor_cx. is_cx_mor. 
rw inc_cx_sys. is_cx_sys. tv. 
rw target_null_arrow; rww target_null_arrow.
rw source_null_arrow; rww target_null_arrow.
rw source_null_arrow; rww target_null_arrow.
rw comp_cx. rw comp_cx. 
rw na_comp_null_arrow.
rww na_comp_null_arrow. 
rw mor_cx; is_cx_mor. 
rw mor_cx; is_cx_mor. 
rw source_null_arrow; rww target_null_arrow.
rw mor_cx; is_cx_mor. 
rw mor_cx; is_cx_mor. 
rw source_null_arrow; rww target_null_arrow.

(** the case [r = na02] and [g = na01] **)
sh (null_arrow (R 2) (R 1)).
sh (null_arrow (R 1) (R 1)).
ee.
rw mor_cx. is_cx_mor. 
rw inc_cx_sys. is_cx_sys. tv. 
rw target_null_arrow; rww target_null_arrow.
rw source_null_arrow; rww target_null_arrow.
rw source_null_arrow; rww target_null_arrow.
rw comp_cx. rw comp_cx. 
rw na_comp_null_arrow.
rww na_comp_null_arrow. 
rw mor_cx; is_cx_mor. 
rw mor_cx; is_cx_mor. 
rw source_null_arrow; rww target_null_arrow.
rw mor_cx; is_cx_mor. 
rw mor_cx; is_cx_mor. 
rw source_null_arrow; rww target_null_arrow.

(** the case [r = na02] and [g = na02] **)
sh (null_arrow (R 2) (R 2)).
sh (null_arrow (R 2) (R 2)).
ee.
rw mor_cx. is_cx_mor. 
rw inc_cx_sys. is_cx_sys. tv. 
rw source_null_arrow; rww target_null_arrow.
rw source_null_arrow; rww target_null_arrow.
tv. 

(** now we show that we have covered all the possible cases. **)


rwi id_cx H2. 
rwi id_cx H2. 

rwi inc_cx_sys H. 
rwi mor_cx H0.
nin H; nin H0;
try (rwi source_null_arrow H1; rwi source_null_arrow H1; 
R_nat_discriminate);
try (rwi source_null_arrow H2;
try (rwi source_null_arrow H2);
nin H2; solve [app or_introl | app or_intror]).
nin H4. 
app or_introl. 
nin H4. app or_intror. 
nin H4. app or_introl. 
nin H4; app or_intror. 
rww ob_source. rwi cx_sys_rw H; ee. 
rww ob_source. 

(** unfortunately because of a glitch in how we did the
[by_cases] at the start we have to basically
recopy the above. **)
rwi id_cx H2. 
rwi id_cx H2. 

rwi inc_cx_sys H. 
rwi mor_cx H0.
nin H; nin H0;
try (rwi source_null_arrow H1; rwi source_null_arrow H1; 
R_nat_discriminate);
try (rwi source_null_arrow H2;
try (rwi source_null_arrow H2);
nin H2; solve [app or_introl | app or_intror]).
nin H3. 
app or_introl. 
nin H3. app or_introl. 
nin H3. app or_intror. 
nin H3; app or_intror. 
rww ob_source. rwi cx_sys_rw H; ee. 
rww ob_source. 

(** we have now finished condition (c) **)

(** condition (d) is easy since arrows are determined
by their source and target **)

ir.
assert (source r = source t).
rww H3. 
assert  (target r = target t).
transitivity (target (comp cx r v)).
rww target_comp. rwi cx_sys_rw H; ee; am. 
rw H4. 
rww target_comp. rwi cx_sys_rw H; ee; am. 

assert (mor (coarse_cat (R 3)) r).
ap cx_mor_mor. wrr mor_cx. 
assert (mor (coarse_cat (R 3)) t).
ap cx_mor_mor. wrr mor_cx. 

rwi mor_coarse_cat H7. 
rwi mor_coarse_cat H8. ee.

assert (r = t).
uh H7; uh H8.
rw H7; rw H8.
rw H5; rw H6; tv. 

sh (id cx (target r)).
ee.
rw id_cx. 
rw inc_cx_sys.

rwi mor_cx H0. nin H0; rw target_null_arrow; is_cx_sys. 
rww ob_target. 
rww source_id. rww ob_target. 
rw H6. 
rww source_id. rww ob_target. 
rww left_id. 
rw H6. rww left_id. 
rww ob_target. rww ob_target. 
Qed. 

(** the two [lf_symbol]'s we want to compare are as follows. **)

Definition lf110 := lf_symbol na11 na01.

Definition lf120 := lf_symbol na12 na02.

Lemma lff110 : lf_forward lf110 = na11. 
Proof.
uf lf110.
rww lf_forward_lf_symbol. 
Qed.

Lemma lfb110 : lf_backward lf110 = na01. 
Proof.
uf lf110.
rww lf_backward_lf_symbol. 
Qed.

Lemma lff120 : lf_forward lf120 = na12. 
Proof.
uf lf120.
rww lf_forward_lf_symbol. 
Qed.

Lemma lfb120 : lf_backward lf120 = na02. 
Proof.
uf lf120.
rww lf_backward_lf_symbol. 
Qed.

Lemma is_lf_symbol_lf110 : is_lf_symbol cx cx_sys lf110.
Proof.
ir.
uhg; ee.
uf lf110. 
ap lf_symbol_like_lf_symbol.
uhg; ee.
ap localizing_system_cx_sys. rw lff110.
rw mor_cx.
is_cx_mor.
rw lfb110. rw inc_cx_sys.
is_cx_sys.
rw lff110. rw lfb110. 
rw target_null_arrow. rww target_null_arrow. 
Qed.

Lemma is_lf_symbol_lf120 : is_lf_symbol cx cx_sys lf120.
Proof.
ir.
uhg; ee.
uf lf120. 
ap lf_symbol_like_lf_symbol.
uhg; ee.
ap localizing_system_cx_sys. rw lff120.
rw mor_cx.
is_cx_mor.
rw lfb120. rw inc_cx_sys.
is_cx_sys.
rw lff120. rw lfb120. 
rw target_null_arrow. rww target_null_arrow. 
Qed.

(** Recall that there are two notions, [lf_beyond] and
[lf_under]. The first is existence of an intermediate arrow,
and the second stronger condition is existence of an
intermediate arrow in the localizing system. Our aim is
to show that lf110 and lf120 cannot be joined by
a sequence of relations of the form [lf_under].
We concretize this by showing that [lf_under lf110 u -> u = lf110]
and [lf_under lf120 u -> u = lf120].
On the other hand we will see that [lf_beyond lf110 lf120]
(meaning that they project to equal arrows in the localization).
**)

Lemma lfv110 : lf_vertex lf110 = R 1.
Proof.
uf lf_vertex. rw lfb110. rww target_null_arrow.
Qed. 

Lemma lfv120 : lf_vertex lf120 = R 2.
Proof.
uf lf_vertex. rw lfb120. rww target_null_arrow.
Qed. 


Lemma under_lf110_same : forall u,
lf_under cx cx_sys lf110 u -> u = lf110.
Proof.
ir.
uh H; ee.
nin H4; ee. 
rwi lfv110 H5. 

assert (x = na11).
rwi inc_cx_sys H4. 
nin H4; 
rwi source_null_arrow H5; try R_nat_discriminate. 
tv. rwi H7 H6.
wr H6.
uf lf_extend.
rw lff110. 
rw lfb110. 
rw comp_cx; try (rw mor_cx; is_cx_mor). 
rw comp_cx; try (rw mor_cx; is_cx_mor). 
rw na_comp_null_arrow. 
rw na_comp_null_arrow. tv. 
rw source_null_arrow. 
rww target_null_arrow. 
rw source_null_arrow; rww target_null_arrow. 
Qed.


Lemma under_lf120_same : forall u,
lf_under cx cx_sys lf120 u -> u = lf120.
Proof.
ir.
uh H; ee.
nin H4; ee. 
rwi lfv120 H5. 

assert (x = na22).
rwi inc_cx_sys H4. 
nin H4; 
rwi source_null_arrow H5; try R_nat_discriminate. 
tv. rwi H7 H6.
wr H6.
uf lf_extend.
rw lff120. 
rw lfb120. 
rw comp_cx; try (rw mor_cx; is_cx_mor). 
rw comp_cx; try (rw mor_cx; is_cx_mor). 
rw na_comp_null_arrow. 
rw na_comp_null_arrow. tv. 
rw source_null_arrow. 
rww target_null_arrow. 
rw source_null_arrow; rww target_null_arrow. 
Qed.

Lemma lf110_different_lf120 : ~lf110 = lf120.
Proof.
uhg; ir. 
assert (lf_vertex lf110 = lf_vertex lf120).
rww H. rwi lfv110 H0. rwi lfv120 H0. 
R_nat_discriminate. 
Qed. 

Lemma lf_beyond_lf110_lf120 : lf_beyond cx cx_sys lf110 lf120.
Proof.
uhg; ee. 
ap has_left_fractions_cx_sys. 
ap is_lf_symbol_lf110. 
ap is_lf_symbol_lf120. 
uf lf110. uf lf120. 
rw source_lf_symbol. rw source_lf_symbol. 
rw source_null_arrow; rww source_null_arrow. 
uf lf110; uf lf120.
rw target_lf_symbol. sy; rw target_lf_symbol.
rw source_null_arrow; rww source_null_arrow.
sh (null_arrow (R 1) (R 2)).
ee.
rw mor_cx. is_cx_mor. 
rw lfv110. rww source_null_arrow. 

uf lf_extend. 
rw lff110. rw lfb110. 
rw comp_cx; try (rw mor_cx; is_cx_mor). 
rw comp_cx; try (rw mor_cx; is_cx_mor). 
rw na_comp_null_arrow. 
rw na_comp_null_arrow. tv. 
rw source_null_arrow. 
rww target_null_arrow. 
rw source_null_arrow; rww target_null_arrow. 
Qed.


Lemma beyond_not_under_counterexample : 
exists a, exists s, exists u, exists v,
(has_left_fractions a s &
is_lf_symbol a s u & 
is_lf_symbol a s v &
lf_beyond a s u v & 
~(exists w, (lf_under a s u w & lf_under a s v w))).
Proof.
ir. 
apply ex_intro with cx. 
sh cx_sys. 
sh lf110. 
sh lf120.
ee.
ap has_left_fractions_cx_sys. 
ap is_lf_symbol_lf110. 
ap is_lf_symbol_lf120. 
ap lf_beyond_lf110_lf120.

uhg; ir.
nin H. 
ee. 
cp (under_lf110_same H). 
cp (under_lf120_same H0).
ap lf110_different_lf120. wrr H1. 
Qed.





End Lf_Counterexample.



(*****************************************************************************************)
(*****************************************************************************************)
(*****************************************************************************************)
(*****************************************************************************************)



(*****************************************************************************************)
(*****************************************************************************************)
(*****************************************************************************************)
(*****************************************************************************************)