Require Export euclidean__axioms.
Require Export euclidean__defs.
Require Export euclidean__tactics.
Require Export lemma__betweennotequal.
Require Export lemma__collinearorder.
Require Export lemma__congruenceflip.
Require Export lemma__congruencesymmetric.
Require Export lemma__congruencetransitive.
Require Export lemma__differenceofparts.
Require Export lemma__equalanglesNC.
Require Export lemma__inequalitysymmetric.
Require Export lemma__interior5.
Require Export lemma__layoffunique.
Require Export lemma__lessthancongruence.
Require Export lemma__partnotequalwhole.
Require Export lemma__ray1.
Require Export lemma__ray2.
Require Export lemma__ray3.
Require Export lemma__ray4.
Require Export lemma__ray5.
Require Export logic.
Definition proposition__04 : forall A B C a b c, (euclidean__axioms.Cong A B a b) -> ((euclidean__axioms.Cong A C a c) -> ((euclidean__defs.CongA B A C b a c) -> ((euclidean__axioms.Cong B C b c) /\ ((euclidean__defs.CongA A B C a b c) /\ (euclidean__defs.CongA A C B a c b))))).
Proof.
intro A.
intro B.
intro C.
intro a.
intro b.
intro c.
intro H.
intro H0.
intro H1.
assert (* Cut *) (euclidean__axioms.nCol b a c) as H2.
- apply (@euclidean__tactics.nCol__notCol b a c).
--apply (@euclidean__tactics.nCol__not__Col b a c).
---apply (@lemma__equalanglesNC.lemma__equalanglesNC B A C b a c H1).

- assert (exists U V u v, (euclidean__defs.Out A B U) /\ ((euclidean__defs.Out A C V) /\ ((euclidean__defs.Out a b u) /\ ((euclidean__defs.Out a c v) /\ ((euclidean__axioms.Cong A U a u) /\ ((euclidean__axioms.Cong A V a v) /\ ((euclidean__axioms.Cong U V u v) /\ (euclidean__axioms.nCol B A C)))))))) as H3 by exact H1.
destruct H3 as [U H4].
destruct H4 as [V H5].
destruct H5 as [u H6].
destruct H6 as [v H7].
destruct H7 as [H8 H9].
destruct H9 as [H10 H11].
destruct H11 as [H12 H13].
destruct H13 as [H14 H15].
destruct H15 as [H16 H17].
destruct H17 as [H18 H19].
destruct H19 as [H20 H21].
assert (* Cut *) (euclidean__axioms.neq a b) as H22.
-- apply (@lemma__ray2.lemma__ray2 a b u H12).
-- assert (* Cut *) (euclidean__axioms.neq b a) as H23.
--- apply (@lemma__inequalitysymmetric.lemma__inequalitysymmetric a b H22).
--- assert (* Cut *) (~(euclidean__axioms.Col A B C)) as H24.
---- intro H24.
assert (* Cut *) (euclidean__axioms.Col B A C) as H25.
----- assert (* Cut *) ((euclidean__axioms.Col B A C) /\ ((euclidean__axioms.Col B C A) /\ ((euclidean__axioms.Col C A B) /\ ((euclidean__axioms.Col A C B) /\ (euclidean__axioms.Col C B A))))) as H25.
------ apply (@lemma__collinearorder.lemma__collinearorder A B C H24).
------ destruct H25 as [H26 H27].
destruct H27 as [H28 H29].
destruct H29 as [H30 H31].
destruct H31 as [H32 H33].
exact H26.
----- apply (@euclidean__tactics.Col__nCol__False B A C H21 H25).
---- assert (* Cut *) (~(A = B)) as H25.
----- intro H25.
assert (* Cut *) (euclidean__axioms.Col A B C) as H26.
------ left.
exact H25.
------ assert (* Cut *) (euclidean__axioms.Col B A C) as H27.
------- assert (* Cut *) ((euclidean__axioms.Col B A C) /\ ((euclidean__axioms.Col B C A) /\ ((euclidean__axioms.Col C A B) /\ ((euclidean__axioms.Col A C B) /\ (euclidean__axioms.Col C B A))))) as H27.
-------- apply (@lemma__collinearorder.lemma__collinearorder A B C H26).
-------- destruct H27 as [H28 H29].
destruct H29 as [H30 H31].
destruct H31 as [H32 H33].
destruct H33 as [H34 H35].
exact H28.
------- apply (@H24 H26).
----- assert (* Cut *) (~(A = C)) as H26.
------ intro H26.
assert (* Cut *) (euclidean__axioms.Col A B C) as H27.
------- right.
left.
exact H26.
------- assert (* Cut *) (euclidean__axioms.Col B A C) as H28.
-------- assert (* Cut *) ((euclidean__axioms.Col B A C) /\ ((euclidean__axioms.Col B C A) /\ ((euclidean__axioms.Col C A B) /\ ((euclidean__axioms.Col A C B) /\ (euclidean__axioms.Col C B A))))) as H28.
--------- apply (@lemma__collinearorder.lemma__collinearorder A B C H27).
--------- destruct H28 as [H29 H30].
destruct H30 as [H31 H32].
destruct H32 as [H33 H34].
destruct H34 as [H35 H36].
exact H29.
-------- apply (@H24 H27).
------ assert (* Cut *) (euclidean__axioms.neq C A) as H27.
------- apply (@lemma__inequalitysymmetric.lemma__inequalitysymmetric A C H26).
------- assert (* Cut *) (~(a = c)) as H28.
-------- intro H28.
assert (* Cut *) (euclidean__axioms.Col b a c) as H29.
--------- right.
right.
left.
exact H28.
--------- apply (@H24).
----------apply (@euclidean__tactics.not__nCol__Col A B C).
-----------intro H30.
apply (@euclidean__tactics.Col__nCol__False b a c H2 H29).

-------- assert (* Cut *) (euclidean__axioms.neq c a) as H29.
--------- apply (@lemma__inequalitysymmetric.lemma__inequalitysymmetric a c H28).
--------- assert (* Cut *) (~(b = c)) as H30.
---------- intro H30.
assert (* Cut *) (euclidean__axioms.Col b a c) as H31.
----------- right.
left.
exact H30.
----------- apply (@H24).
------------apply (@euclidean__tactics.not__nCol__Col A B C).
-------------intro H32.
apply (@euclidean__tactics.Col__nCol__False b a c H2 H31).

---------- assert (* Cut *) (euclidean__axioms.neq c b) as H31.
----------- apply (@lemma__inequalitysymmetric.lemma__inequalitysymmetric b c H30).
----------- assert (* Cut *) (~(B = C)) as H32.
------------ intro H32.
assert (* Cut *) (euclidean__axioms.Col A B C) as H33.
------------- right.
right.
left.
exact H32.
------------- assert (* Cut *) (euclidean__axioms.Col B A C) as H34.
-------------- assert (* Cut *) ((euclidean__axioms.Col B A C) /\ ((euclidean__axioms.Col B C A) /\ ((euclidean__axioms.Col C A B) /\ ((euclidean__axioms.Col A C B) /\ (euclidean__axioms.Col C B A))))) as H34.
--------------- apply (@lemma__collinearorder.lemma__collinearorder A B C H33).
--------------- destruct H34 as [H35 H36].
destruct H36 as [H37 H38].
destruct H38 as [H39 H40].
destruct H40 as [H41 H42].
exact H35.
-------------- apply (@H24 H33).
------------ assert (* Cut *) (euclidean__axioms.neq C B) as H33.
------------- apply (@lemma__inequalitysymmetric.lemma__inequalitysymmetric B C H32).
------------- assert (* Cut *) ((euclidean__axioms.BetS A U B) \/ ((B = U) \/ (euclidean__axioms.BetS A B U))) as H34.
-------------- apply (@lemma__ray1.lemma__ray1 A B U H8).
-------------- assert (* Cut *) (euclidean__axioms.Cong B V b v) as H35.
--------------- assert ((euclidean__axioms.BetS A U B) \/ ((B = U) \/ (euclidean__axioms.BetS A B U))) as H35 by exact H34.
assert ((euclidean__axioms.BetS A U B) \/ ((B = U) \/ (euclidean__axioms.BetS A B U))) as __TmpHyp by exact H35.
destruct __TmpHyp as [H36|H36].
---------------- assert (* Cut *) (euclidean__axioms.Cong A U A U) as H37.
----------------- apply (@euclidean__axioms.cn__congruencereflexive A U).
----------------- assert (* Cut *) (euclidean__defs.Lt A U A B) as H38.
------------------ exists U.
split.
------------------- exact H36.
------------------- exact H37.
------------------ assert (* Cut *) (euclidean__defs.Lt A U a b) as H39.
------------------- apply (@lemma__lessthancongruence.lemma__lessthancongruence A U A B a b H38 H).
------------------- assert (exists w, (euclidean__axioms.BetS a w b) /\ (euclidean__axioms.Cong a w A U)) as H40 by exact H39.
destruct H40 as [w H41].
destruct H41 as [H42 H43].
assert (* Cut *) (euclidean__axioms.Cong a w a u) as H44.
-------------------- apply (@lemma__congruencetransitive.lemma__congruencetransitive a w A U a u H43 H16).
-------------------- assert (* Cut *) (euclidean__axioms.neq a b) as H45.
--------------------- assert (* Cut *) ((euclidean__axioms.neq w b) /\ ((euclidean__axioms.neq a w) /\ (euclidean__axioms.neq a b))) as H45.
---------------------- apply (@lemma__betweennotequal.lemma__betweennotequal a w b H42).
---------------------- destruct H45 as [H46 H47].
destruct H47 as [H48 H49].
exact H49.
--------------------- assert (* Cut *) (euclidean__defs.Out a b w) as H46.
---------------------- apply (@lemma__ray4.lemma__ray4 a b w).
-----------------------left.
exact H42.

----------------------- exact H45.
---------------------- assert (euclidean__axioms.Cong a w a u) as H47 by exact H44.
assert (* Cut *) (w = u) as H48.
----------------------- apply (@lemma__layoffunique.lemma__layoffunique a b w u H46 H12 H47).
----------------------- assert (* Cut *) (euclidean__axioms.BetS a u b) as H49.
------------------------ apply (@eq__ind__r euclidean__axioms.Point u (fun w0 => (euclidean__axioms.BetS a w0 b) -> ((euclidean__axioms.Cong a w0 A U) -> ((euclidean__axioms.Cong a w0 a u) -> ((euclidean__defs.Out a b w0) -> ((euclidean__axioms.Cong a w0 a u) -> (euclidean__axioms.BetS a u b))))))) with (x := w).
-------------------------intro H49.
intro H50.
intro H51.
intro H52.
intro H53.
exact H49.

------------------------- exact H48.
------------------------- exact H42.
------------------------- exact H43.
------------------------- exact H44.
------------------------- exact H46.
------------------------- exact H47.
------------------------ assert (* Cut *) (euclidean__axioms.Cong U B u b) as H50.
------------------------- apply (@lemma__differenceofparts.lemma__differenceofparts A U B a u b H16 H H36 H49).
------------------------- assert (* Cut *) (euclidean__axioms.Cong V B v b) as H51.
-------------------------- apply (@euclidean__axioms.axiom__5__line A U B V a u b v H50 H18 H20 H36 H49 H16).
-------------------------- assert (* Cut *) (euclidean__axioms.Cong B V b v) as H52.
--------------------------- assert (* Cut *) ((euclidean__axioms.Cong B V b v) /\ ((euclidean__axioms.Cong B V v b) /\ (euclidean__axioms.Cong V B b v))) as H52.
---------------------------- apply (@lemma__congruenceflip.lemma__congruenceflip V B v b H51).
---------------------------- destruct H52 as [H53 H54].
destruct H54 as [H55 H56].
exact H53.
--------------------------- exact H52.
---------------- destruct H36 as [H37|H37].
----------------- assert (* Cut *) (euclidean__axioms.Cong B V u v) as H38.
------------------ apply (@eq__ind__r euclidean__axioms.Point U (fun B0 => (euclidean__axioms.Cong A B0 a b) -> ((euclidean__defs.CongA B0 A C b a c) -> ((euclidean__defs.Out A B0 U) -> ((euclidean__axioms.nCol B0 A C) -> ((~(euclidean__axioms.Col A B0 C)) -> ((~(A = B0)) -> ((~(B0 = C)) -> ((euclidean__axioms.neq C B0) -> (euclidean__axioms.Cong B0 V u v)))))))))) with (x := B).
-------------------intro H38.
intro H39.
intro H40.
intro H41.
intro H42.
intro H43.
intro H44.
intro H45.
exact H20.

------------------- exact H37.
------------------- exact H.
------------------- exact H1.
------------------- exact H8.
------------------- exact H21.
------------------- exact H24.
------------------- exact H25.
------------------- exact H32.
------------------- exact H33.
------------------ assert (* Cut *) (euclidean__axioms.Cong a b A B) as H39.
------------------- apply (@lemma__congruencesymmetric.lemma__congruencesymmetric a A B b H).
------------------- assert (* Cut *) (euclidean__axioms.Cong A B A B) as H40.
-------------------- apply (@euclidean__axioms.cn__congruencereflexive A B).
-------------------- assert (* Cut *) (euclidean__axioms.Cong A B A U) as H41.
--------------------- apply (@eq__ind__r euclidean__axioms.Point U (fun B0 => (euclidean__axioms.Cong A B0 a b) -> ((euclidean__defs.CongA B0 A C b a c) -> ((euclidean__defs.Out A B0 U) -> ((euclidean__axioms.nCol B0 A C) -> ((~(euclidean__axioms.Col A B0 C)) -> ((~(A = B0)) -> ((~(B0 = C)) -> ((euclidean__axioms.neq C B0) -> ((euclidean__axioms.Cong B0 V u v) -> ((euclidean__axioms.Cong a b A B0) -> ((euclidean__axioms.Cong A B0 A B0) -> (euclidean__axioms.Cong A B0 A U))))))))))))) with (x := B).
----------------------intro H41.
intro H42.
intro H43.
intro H44.
intro H45.
intro H46.
intro H47.
intro H48.
intro H49.
intro H50.
intro H51.
exact H51.

---------------------- exact H37.
---------------------- exact H.
---------------------- exact H1.
---------------------- exact H8.
---------------------- exact H21.
---------------------- exact H24.
---------------------- exact H25.
---------------------- exact H32.
---------------------- exact H33.
---------------------- exact H38.
---------------------- exact H39.
---------------------- exact H40.
--------------------- assert (* Cut *) (euclidean__axioms.Cong a b A U) as H42.
---------------------- apply (@eq__ind__r euclidean__axioms.Point U (fun B0 => (euclidean__axioms.Cong A B0 a b) -> ((euclidean__defs.CongA B0 A C b a c) -> ((euclidean__defs.Out A B0 U) -> ((euclidean__axioms.nCol B0 A C) -> ((~(euclidean__axioms.Col A B0 C)) -> ((~(A = B0)) -> ((~(B0 = C)) -> ((euclidean__axioms.neq C B0) -> ((euclidean__axioms.Cong B0 V u v) -> ((euclidean__axioms.Cong a b A B0) -> ((euclidean__axioms.Cong A B0 A B0) -> ((euclidean__axioms.Cong A B0 A U) -> (euclidean__axioms.Cong a b A U)))))))))))))) with (x := B).
-----------------------intro H42.
intro H43.
intro H44.
intro H45.
intro H46.
intro H47.
intro H48.
intro H49.
intro H50.
intro H51.
intro H52.
intro H53.
exact H51.

----------------------- exact H37.
----------------------- exact H.
----------------------- exact H1.
----------------------- exact H8.
----------------------- exact H21.
----------------------- exact H24.
----------------------- exact H25.
----------------------- exact H32.
----------------------- exact H33.
----------------------- exact H38.
----------------------- exact H39.
----------------------- exact H40.
----------------------- exact H41.
---------------------- assert (* Cut *) (euclidean__axioms.Cong a b a u) as H43.
----------------------- apply (@lemma__congruencetransitive.lemma__congruencetransitive a b A U a u H42 H16).
----------------------- assert (* Cut *) ((euclidean__axioms.BetS a u b) \/ ((b = u) \/ (euclidean__axioms.BetS a b u))) as H44.
------------------------ apply (@lemma__ray1.lemma__ray1 a b u H12).
------------------------ assert (* Cut *) (b = u) as H45.
------------------------- assert ((euclidean__axioms.BetS a u b) \/ ((b = u) \/ (euclidean__axioms.BetS a b u))) as H45 by exact H44.
assert ((euclidean__axioms.BetS a u b) \/ ((b = u) \/ (euclidean__axioms.BetS a b u))) as __TmpHyp0 by exact H45.
destruct __TmpHyp0 as [H46|H46].
-------------------------- assert (* Cut *) (~(euclidean__axioms.neq b u)) as H47.
--------------------------- intro H47.
assert (* Cut *) (~(euclidean__axioms.Cong a u a b)) as H48.
---------------------------- apply (@lemma__partnotequalwhole.lemma__partnotequalwhole a u b H46).
---------------------------- assert (* Cut *) (euclidean__axioms.Cong a u a b) as H49.
----------------------------- apply (@lemma__congruencesymmetric.lemma__congruencesymmetric a a b u H43).
----------------------------- apply (@H24).
------------------------------apply (@euclidean__tactics.not__nCol__Col A B C).
-------------------------------intro H50.
apply (@H48 H49).

--------------------------- apply (@euclidean__tactics.NNPP (b = u)).
----------------------------intro H48.
destruct H2 as [H49 H50].
destruct H21 as [H51 H52].
destruct H50 as [H53 H54].
destruct H52 as [H55 H56].
destruct H54 as [H57 H58].
destruct H56 as [H59 H60].
destruct H58 as [H61 H62].
destruct H60 as [H63 H64].
destruct H62 as [H65 H66].
destruct H64 as [H67 H68].
assert (* Cut *) (False) as H69.
----------------------------- apply (@H47 H48).
----------------------------- contradiction H69.

-------------------------- destruct H46 as [H47|H47].
--------------------------- exact H47.
--------------------------- assert (* Cut *) (~(euclidean__axioms.neq b u)) as H48.
---------------------------- intro H48.
assert (* Cut *) (~(euclidean__axioms.Cong a b a u)) as H49.
----------------------------- apply (@lemma__partnotequalwhole.lemma__partnotequalwhole a b u H47).
----------------------------- assert (* Cut *) (euclidean__axioms.Cong a b A B) as H50.
------------------------------ apply (@eq__ind__r euclidean__axioms.Point U (fun B0 => (euclidean__axioms.Cong A B0 a b) -> ((euclidean__defs.CongA B0 A C b a c) -> ((euclidean__defs.Out A B0 U) -> ((euclidean__axioms.nCol B0 A C) -> ((~(euclidean__axioms.Col A B0 C)) -> ((~(A = B0)) -> ((~(B0 = C)) -> ((euclidean__axioms.neq C B0) -> ((euclidean__axioms.Cong B0 V u v) -> ((euclidean__axioms.Cong a b A B0) -> ((euclidean__axioms.Cong A B0 A B0) -> ((euclidean__axioms.Cong A B0 A U) -> (euclidean__axioms.Cong a b A B0)))))))))))))) with (x := B).
-------------------------------intro H50.
intro H51.
intro H52.
intro H53.
intro H54.
intro H55.
intro H56.
intro H57.
intro H58.
intro H59.
intro H60.
intro H61.
exact H42.

------------------------------- exact H37.
------------------------------- exact H.
------------------------------- exact H1.
------------------------------- exact H8.
------------------------------- exact H21.
------------------------------- exact H24.
------------------------------- exact H25.
------------------------------- exact H32.
------------------------------- exact H33.
------------------------------- exact H38.
------------------------------- exact H39.
------------------------------- exact H40.
------------------------------- exact H41.
------------------------------ assert (* Cut *) (euclidean__axioms.Cong A B A B) as H51.
------------------------------- apply (@eq__ind__r euclidean__axioms.Point U (fun B0 => (euclidean__axioms.Cong A B0 a b) -> ((euclidean__defs.CongA B0 A C b a c) -> ((euclidean__defs.Out A B0 U) -> ((euclidean__axioms.nCol B0 A C) -> ((~(euclidean__axioms.Col A B0 C)) -> ((~(A = B0)) -> ((~(B0 = C)) -> ((euclidean__axioms.neq C B0) -> ((euclidean__axioms.Cong B0 V u v) -> ((euclidean__axioms.Cong a b A B0) -> ((euclidean__axioms.Cong A B0 A B0) -> ((euclidean__axioms.Cong A B0 A U) -> ((euclidean__axioms.Cong a b A B0) -> (euclidean__axioms.Cong A B0 A B0))))))))))))))) with (x := B).
--------------------------------intro H51.
intro H52.
intro H53.
intro H54.
intro H55.
intro H56.
intro H57.
intro H58.
intro H59.
intro H60.
intro H61.
intro H62.
intro H63.
exact H61.

-------------------------------- exact H37.
-------------------------------- exact H.
-------------------------------- exact H1.
-------------------------------- exact H8.
-------------------------------- exact H21.
-------------------------------- exact H24.
-------------------------------- exact H25.
-------------------------------- exact H32.
-------------------------------- exact H33.
-------------------------------- exact H38.
-------------------------------- exact H39.
-------------------------------- exact H40.
-------------------------------- exact H41.
-------------------------------- exact H50.
------------------------------- assert (* Cut *) (euclidean__axioms.Cong A B A U) as H52.
-------------------------------- apply (@eq__ind__r euclidean__axioms.Point U (fun B0 => (euclidean__axioms.Cong A B0 a b) -> ((euclidean__defs.CongA B0 A C b a c) -> ((euclidean__defs.Out A B0 U) -> ((euclidean__axioms.nCol B0 A C) -> ((~(euclidean__axioms.Col A B0 C)) -> ((~(A = B0)) -> ((~(B0 = C)) -> ((euclidean__axioms.neq C B0) -> ((euclidean__axioms.Cong B0 V u v) -> ((euclidean__axioms.Cong a b A B0) -> ((euclidean__axioms.Cong A B0 A B0) -> ((euclidean__axioms.Cong A B0 A U) -> ((euclidean__axioms.Cong a b A B0) -> ((euclidean__axioms.Cong A B0 A B0) -> (euclidean__axioms.Cong A B0 A U)))))))))))))))) with (x := B).
---------------------------------intro H52.
intro H53.
intro H54.
intro H55.
intro H56.
intro H57.
intro H58.
intro H59.
intro H60.
intro H61.
intro H62.
intro H63.
intro H64.
intro H65.
exact H65.

--------------------------------- exact H37.
--------------------------------- exact H.
--------------------------------- exact H1.
--------------------------------- exact H8.
--------------------------------- exact H21.
--------------------------------- exact H24.
--------------------------------- exact H25.
--------------------------------- exact H32.
--------------------------------- exact H33.
--------------------------------- exact H38.
--------------------------------- exact H39.
--------------------------------- exact H40.
--------------------------------- exact H41.
--------------------------------- exact H50.
--------------------------------- exact H51.
-------------------------------- assert (* Cut *) (euclidean__axioms.Cong A B a u) as H53.
--------------------------------- apply (@eq__ind__r euclidean__axioms.Point U (fun B0 => (euclidean__axioms.Cong A B0 a b) -> ((euclidean__defs.CongA B0 A C b a c) -> ((euclidean__defs.Out A B0 U) -> ((euclidean__axioms.nCol B0 A C) -> ((~(euclidean__axioms.Col A B0 C)) -> ((~(A = B0)) -> ((~(B0 = C)) -> ((euclidean__axioms.neq C B0) -> ((euclidean__axioms.Cong B0 V u v) -> ((euclidean__axioms.Cong a b A B0) -> ((euclidean__axioms.Cong A B0 A B0) -> ((euclidean__axioms.Cong A B0 A U) -> ((euclidean__axioms.Cong a b A B0) -> ((euclidean__axioms.Cong A B0 A B0) -> ((euclidean__axioms.Cong A B0 A U) -> (euclidean__axioms.Cong A B0 a u))))))))))))))))) with (x := B).
----------------------------------intro H53.
intro H54.
intro H55.
intro H56.
intro H57.
intro H58.
intro H59.
intro H60.
intro H61.
intro H62.
intro H63.
intro H64.
intro H65.
intro H66.
intro H67.
exact H16.

---------------------------------- exact H37.
---------------------------------- exact H.
---------------------------------- exact H1.
---------------------------------- exact H8.
---------------------------------- exact H21.
---------------------------------- exact H24.
---------------------------------- exact H25.
---------------------------------- exact H32.
---------------------------------- exact H33.
---------------------------------- exact H38.
---------------------------------- exact H39.
---------------------------------- exact H40.
---------------------------------- exact H41.
---------------------------------- exact H50.
---------------------------------- exact H51.
---------------------------------- exact H52.
--------------------------------- assert (* Cut *) (euclidean__axioms.Cong a b a u) as H54.
---------------------------------- apply (@eq__ind__r euclidean__axioms.Point U (fun B0 => (euclidean__axioms.Cong A B0 a b) -> ((euclidean__defs.CongA B0 A C b a c) -> ((euclidean__defs.Out A B0 U) -> ((euclidean__axioms.nCol B0 A C) -> ((~(euclidean__axioms.Col A B0 C)) -> ((~(A = B0)) -> ((~(B0 = C)) -> ((euclidean__axioms.neq C B0) -> ((euclidean__axioms.Cong B0 V u v) -> ((euclidean__axioms.Cong a b A B0) -> ((euclidean__axioms.Cong A B0 A B0) -> ((euclidean__axioms.Cong A B0 A U) -> ((euclidean__axioms.Cong a b A B0) -> ((euclidean__axioms.Cong A B0 A B0) -> ((euclidean__axioms.Cong A B0 A U) -> ((euclidean__axioms.Cong A B0 a u) -> (euclidean__axioms.Cong a b a u)))))))))))))))))) with (x := B).
-----------------------------------intro H54.
intro H55.
intro H56.
intro H57.
intro H58.
intro H59.
intro H60.
intro H61.
intro H62.
intro H63.
intro H64.
intro H65.
intro H66.
intro H67.
intro H68.
intro H69.
exact H43.

----------------------------------- exact H37.
----------------------------------- exact H.
----------------------------------- exact H1.
----------------------------------- exact H8.
----------------------------------- exact H21.
----------------------------------- exact H24.
----------------------------------- exact H25.
----------------------------------- exact H32.
----------------------------------- exact H33.
----------------------------------- exact H38.
----------------------------------- exact H39.
----------------------------------- exact H40.
----------------------------------- exact H41.
----------------------------------- exact H50.
----------------------------------- exact H51.
----------------------------------- exact H52.
----------------------------------- exact H53.
---------------------------------- apply (@H24).
-----------------------------------apply (@euclidean__tactics.not__nCol__Col A B C).
------------------------------------intro H55.
apply (@H49 H54).

---------------------------- apply (@euclidean__tactics.NNPP (b = u)).
-----------------------------intro H49.
destruct H2 as [H50 H51].
destruct H21 as [H52 H53].
destruct H51 as [H54 H55].
destruct H53 as [H56 H57].
destruct H55 as [H58 H59].
destruct H57 as [H60 H61].
destruct H59 as [H62 H63].
destruct H61 as [H64 H65].
destruct H63 as [H66 H67].
destruct H65 as [H68 H69].
assert (* Cut *) (False) as H70.
------------------------------ apply (@H48 H49).
------------------------------ contradiction H70.

------------------------- assert (* Cut *) (euclidean__axioms.Cong B V b v) as H46.
-------------------------- apply (@eq__ind__r euclidean__axioms.Point u (fun b0 => (euclidean__axioms.Cong A B a b0) -> ((euclidean__defs.CongA B A C b0 a c) -> ((euclidean__axioms.nCol b0 a c) -> ((euclidean__defs.Out a b0 u) -> ((euclidean__axioms.neq a b0) -> ((euclidean__axioms.neq b0 a) -> ((~(b0 = c)) -> ((euclidean__axioms.neq c b0) -> ((euclidean__axioms.Cong a b0 A B) -> ((euclidean__axioms.Cong a b0 A U) -> ((euclidean__axioms.Cong a b0 a u) -> (((euclidean__axioms.BetS a u b0) \/ ((b0 = u) \/ (euclidean__axioms.BetS a b0 u))) -> (euclidean__axioms.Cong B V b0 v)))))))))))))) with (x := b).
---------------------------intro H46.
intro H47.
intro H48.
intro H49.
intro H50.
intro H51.
intro H52.
intro H53.
intro H54.
intro H55.
intro H56.
intro H57.
apply (@eq__ind__r euclidean__axioms.Point U (fun B0 => (euclidean__axioms.Cong A B0 a u) -> ((euclidean__defs.CongA B0 A C u a c) -> ((euclidean__defs.Out A B0 U) -> ((euclidean__axioms.nCol B0 A C) -> ((~(euclidean__axioms.Col A B0 C)) -> ((~(A = B0)) -> ((~(B0 = C)) -> ((euclidean__axioms.neq C B0) -> ((euclidean__axioms.Cong B0 V u v) -> ((euclidean__axioms.Cong a u A B0) -> ((euclidean__axioms.Cong A B0 A B0) -> ((euclidean__axioms.Cong A B0 A U) -> (euclidean__axioms.Cong B0 V u v)))))))))))))) with (x := B).
----------------------------intro H58.
intro H59.
intro H60.
intro H61.
intro H62.
intro H63.
intro H64.
intro H65.
intro H66.
intro H67.
intro H68.
intro H69.
exact H66.

---------------------------- exact H37.
---------------------------- exact H46.
---------------------------- exact H47.
---------------------------- exact H8.
---------------------------- exact H21.
---------------------------- exact H24.
---------------------------- exact H25.
---------------------------- exact H32.
---------------------------- exact H33.
---------------------------- exact H38.
---------------------------- exact H54.
---------------------------- exact H40.
---------------------------- exact H41.

--------------------------- exact H45.
--------------------------- exact H.
--------------------------- exact H1.
--------------------------- exact H2.
--------------------------- exact H12.
--------------------------- exact H22.
--------------------------- exact H23.
--------------------------- exact H30.
--------------------------- exact H31.
--------------------------- exact H39.
--------------------------- exact H42.
--------------------------- exact H43.
--------------------------- exact H44.
-------------------------- exact H46.
----------------- assert (* Cut *) (euclidean__axioms.Cong A B A B) as H38.
------------------ apply (@euclidean__axioms.cn__congruencereflexive A B).
------------------ assert (* Cut *) (euclidean__defs.Lt A B A U) as H39.
------------------- exists B.
split.
-------------------- exact H37.
-------------------- exact H38.
------------------- assert (* Cut *) (euclidean__defs.Lt A B a u) as H40.
-------------------- apply (@lemma__lessthancongruence.lemma__lessthancongruence A B A U a u H39 H16).
-------------------- assert (exists f, (euclidean__axioms.BetS a f u) /\ (euclidean__axioms.Cong a f A B)) as H41 by exact H40.
destruct H41 as [f H42].
destruct H42 as [H43 H44].
assert (* Cut *) (euclidean__axioms.neq a u) as H45.
--------------------- assert (* Cut *) ((euclidean__axioms.neq f u) /\ ((euclidean__axioms.neq a f) /\ (euclidean__axioms.neq a u))) as H45.
---------------------- apply (@lemma__betweennotequal.lemma__betweennotequal a f u H43).
---------------------- destruct H45 as [H46 H47].
destruct H47 as [H48 H49].
exact H49.
--------------------- assert (* Cut *) (euclidean__defs.Out a u f) as H46.
---------------------- apply (@lemma__ray4.lemma__ray4 a u f).
-----------------------left.
exact H43.

----------------------- exact H45.
---------------------- assert (* Cut *) (euclidean__defs.Out a u b) as H47.
----------------------- apply (@lemma__ray5.lemma__ray5 a b u H12).
----------------------- assert (* Cut *) (euclidean__defs.Out a b f) as H48.
------------------------ apply (@lemma__ray3.lemma__ray3 a u b f H47 H46).
------------------------ assert (* Cut *) (euclidean__axioms.Cong a f a b) as H49.
------------------------- apply (@lemma__congruencetransitive.lemma__congruencetransitive a f A B a b H44 H).
------------------------- assert (* Cut *) (f = b) as H50.
-------------------------- apply (@lemma__layoffunique.lemma__layoffunique a u f b H46 H47 H49).
-------------------------- assert (* Cut *) (euclidean__axioms.BetS a b u) as H51.
--------------------------- apply (@eq__ind__r euclidean__axioms.Point b (fun f0 => (euclidean__axioms.BetS a f0 u) -> ((euclidean__axioms.Cong a f0 A B) -> ((euclidean__defs.Out a u f0) -> ((euclidean__defs.Out a b f0) -> ((euclidean__axioms.Cong a f0 a b) -> (euclidean__axioms.BetS a b u))))))) with (x := f).
----------------------------intro H51.
intro H52.
intro H53.
intro H54.
intro H55.
exact H51.

---------------------------- exact H50.
---------------------------- exact H43.
---------------------------- exact H44.
---------------------------- exact H46.
---------------------------- exact H48.
---------------------------- exact H49.
--------------------------- assert (* Cut *) (euclidean__axioms.Cong B U b u) as H52.
---------------------------- apply (@lemma__differenceofparts.lemma__differenceofparts A B U a b u H H16 H37 H51).
---------------------------- assert (* Cut *) (euclidean__axioms.BetS a b u) as H53.
----------------------------- apply (@eq__ind__r euclidean__axioms.Point b (fun f0 => (euclidean__axioms.BetS a f0 u) -> ((euclidean__axioms.Cong a f0 A B) -> ((euclidean__defs.Out a u f0) -> ((euclidean__defs.Out a b f0) -> ((euclidean__axioms.Cong a f0 a b) -> (euclidean__axioms.BetS a b u))))))) with (x := f).
------------------------------intro H53.
intro H54.
intro H55.
intro H56.
intro H57.
exact H51.

------------------------------ exact H50.
------------------------------ exact H43.
------------------------------ exact H44.
------------------------------ exact H46.
------------------------------ exact H48.
------------------------------ exact H49.
----------------------------- assert (* Cut *) (euclidean__axioms.Cong B U b u) as H54.
------------------------------ apply (@eq__ind__r euclidean__axioms.Point b (fun f0 => (euclidean__axioms.BetS a f0 u) -> ((euclidean__axioms.Cong a f0 A B) -> ((euclidean__defs.Out a u f0) -> ((euclidean__defs.Out a b f0) -> ((euclidean__axioms.Cong a f0 a b) -> (euclidean__axioms.Cong B U b u))))))) with (x := f).
-------------------------------intro H54.
intro H55.
intro H56.
intro H57.
intro H58.
exact H52.

------------------------------- exact H50.
------------------------------- exact H43.
------------------------------- exact H44.
------------------------------- exact H46.
------------------------------- exact H48.
------------------------------- exact H49.
------------------------------ assert (* Cut *) (euclidean__axioms.Cong B V b v) as H55.
------------------------------- apply (@lemma__interior5.lemma__interior5 A B U V a b u v H37 H53 H H54 H18 H20).
------------------------------- exact H55.
--------------- assert (* Cut *) ((euclidean__axioms.BetS A V C) \/ ((C = V) \/ (euclidean__axioms.BetS A C V))) as H36.
---------------- apply (@lemma__ray1.lemma__ray1 A C V H10).
---------------- assert (* Cut *) (euclidean__axioms.Cong B C b c) as H37.
----------------- assert ((euclidean__axioms.BetS A V C) \/ ((C = V) \/ (euclidean__axioms.BetS A C V))) as H37 by exact H36.
assert ((euclidean__axioms.BetS A V C) \/ ((C = V) \/ (euclidean__axioms.BetS A C V))) as __TmpHyp by exact H37.
destruct __TmpHyp as [H38|H38].
------------------ assert (* Cut *) (euclidean__axioms.Cong A V A V) as H39.
------------------- apply (@euclidean__axioms.cn__congruencereflexive A V).
------------------- assert (* Cut *) (euclidean__defs.Lt A V A C) as H40.
-------------------- exists V.
split.
--------------------- exact H38.
--------------------- exact H39.
-------------------- assert (* Cut *) (euclidean__defs.Lt A V a c) as H41.
--------------------- apply (@lemma__lessthancongruence.lemma__lessthancongruence A V A C a c H40 H0).
--------------------- assert (exists g, (euclidean__axioms.BetS a g c) /\ (euclidean__axioms.Cong a g A V)) as H42 by exact H41.
destruct H42 as [g H43].
destruct H43 as [H44 H45].
assert (* Cut *) (euclidean__axioms.neq a g) as H46.
---------------------- assert (* Cut *) ((euclidean__axioms.neq g c) /\ ((euclidean__axioms.neq a g) /\ (euclidean__axioms.neq a c))) as H46.
----------------------- apply (@lemma__betweennotequal.lemma__betweennotequal a g c H44).
----------------------- destruct H46 as [H47 H48].
destruct H48 as [H49 H50].
exact H49.
---------------------- assert (* Cut *) (euclidean__defs.Out a g c) as H47.
----------------------- apply (@lemma__ray4.lemma__ray4 a g c).
------------------------right.
right.
exact H44.

------------------------ exact H46.
----------------------- assert (* Cut *) (euclidean__defs.Out a c g) as H48.
------------------------ apply (@lemma__ray5.lemma__ray5 a g c H47).
------------------------ assert (* Cut *) (euclidean__axioms.Cong a g a v) as H49.
------------------------- apply (@lemma__congruencetransitive.lemma__congruencetransitive a g A V a v H45 H18).
------------------------- assert (* Cut *) (g = v) as H50.
-------------------------- apply (@lemma__layoffunique.lemma__layoffunique a c g v H48 H14 H49).
-------------------------- assert (* Cut *) (euclidean__axioms.BetS a v c) as H51.
--------------------------- apply (@eq__ind__r euclidean__axioms.Point v (fun g0 => (euclidean__axioms.BetS a g0 c) -> ((euclidean__axioms.Cong a g0 A V) -> ((euclidean__axioms.neq a g0) -> ((euclidean__defs.Out a g0 c) -> ((euclidean__defs.Out a c g0) -> ((euclidean__axioms.Cong a g0 a v) -> (euclidean__axioms.BetS a v c)))))))) with (x := g).
----------------------------intro H51.
intro H52.
intro H53.
intro H54.
intro H55.
intro H56.
exact H51.

---------------------------- exact H50.
---------------------------- exact H44.
---------------------------- exact H45.
---------------------------- exact H46.
---------------------------- exact H47.
---------------------------- exact H48.
---------------------------- exact H49.
--------------------------- assert (* Cut *) (euclidean__axioms.Cong V C v c) as H52.
---------------------------- apply (@lemma__differenceofparts.lemma__differenceofparts A V C a v c H18 H0 H38 H51).
---------------------------- assert (* Cut *) (euclidean__axioms.Cong V B v b) as H53.
----------------------------- assert (* Cut *) ((euclidean__axioms.Cong V B v b) /\ ((euclidean__axioms.Cong V B b v) /\ (euclidean__axioms.Cong B V v b))) as H53.
------------------------------ apply (@lemma__congruenceflip.lemma__congruenceflip B V b v H35).
------------------------------ destruct H53 as [H54 H55].
destruct H55 as [H56 H57].
exact H54.
----------------------------- assert (* Cut *) (euclidean__axioms.Cong B C b c) as H54.
------------------------------ apply (@euclidean__axioms.axiom__5__line A V C B a v c b H52 H H53 H38 H51 H18).
------------------------------ exact H54.
------------------ destruct H38 as [H39|H39].
------------------- assert (* Cut *) (euclidean__axioms.Cong A C a v) as H40.
-------------------- apply (@eq__ind__r euclidean__axioms.Point V (fun C0 => (euclidean__axioms.Cong A C0 a c) -> ((euclidean__defs.CongA B A C0 b a c) -> ((euclidean__defs.Out A C0 V) -> ((euclidean__axioms.nCol B A C0) -> ((~(euclidean__axioms.Col A B C0)) -> ((~(A = C0)) -> ((euclidean__axioms.neq C0 A) -> ((~(B = C0)) -> ((euclidean__axioms.neq C0 B) -> (euclidean__axioms.Cong A C0 a v))))))))))) with (x := C).
---------------------intro H40.
intro H41.
intro H42.
intro H43.
intro H44.
intro H45.
intro H46.
intro H47.
intro H48.
exact H18.

--------------------- exact H39.
--------------------- exact H0.
--------------------- exact H1.
--------------------- exact H10.
--------------------- exact H21.
--------------------- exact H24.
--------------------- exact H26.
--------------------- exact H27.
--------------------- exact H32.
--------------------- exact H33.
-------------------- assert (* Cut *) (euclidean__axioms.Cong a c A C) as H41.
--------------------- apply (@lemma__congruencesymmetric.lemma__congruencesymmetric a A C c H0).
--------------------- assert (* Cut *) (euclidean__axioms.Cong a c a v) as H42.
---------------------- apply (@lemma__congruencetransitive.lemma__congruencetransitive a c A C a v H41 H40).
---------------------- assert (* Cut *) (euclidean__axioms.neq a c) as H43.
----------------------- apply (@eq__ind__r euclidean__axioms.Point V (fun C0 => (euclidean__axioms.Cong A C0 a c) -> ((euclidean__defs.CongA B A C0 b a c) -> ((euclidean__defs.Out A C0 V) -> ((euclidean__axioms.nCol B A C0) -> ((~(euclidean__axioms.Col A B C0)) -> ((~(A = C0)) -> ((euclidean__axioms.neq C0 A) -> ((~(B = C0)) -> ((euclidean__axioms.neq C0 B) -> ((euclidean__axioms.Cong A C0 a v) -> ((euclidean__axioms.Cong a c A C0) -> (euclidean__axioms.neq a c))))))))))))) with (x := C).
------------------------intro H43.
intro H44.
intro H45.
intro H46.
intro H47.
intro H48.
intro H49.
intro H50.
intro H51.
intro H52.
intro H53.
exact H28.

------------------------ exact H39.
------------------------ exact H0.
------------------------ exact H1.
------------------------ exact H10.
------------------------ exact H21.
------------------------ exact H24.
------------------------ exact H26.
------------------------ exact H27.
------------------------ exact H32.
------------------------ exact H33.
------------------------ exact H40.
------------------------ exact H41.
----------------------- assert (* Cut *) (c = c) as H44.
------------------------ apply (@logic.eq__refl Point c).
------------------------ assert (* Cut *) (euclidean__defs.Out a c c) as H45.
------------------------- apply (@lemma__ray4.lemma__ray4 a c c).
--------------------------right.
left.
exact H44.

-------------------------- exact H43.
------------------------- assert (* Cut *) (c = v) as H46.
-------------------------- apply (@lemma__layoffunique.lemma__layoffunique a c c v H45 H14 H42).
-------------------------- assert (* Cut *) (euclidean__axioms.Cong B C b v) as H47.
--------------------------- apply (@eq__ind__r euclidean__axioms.Point v (fun c0 => (euclidean__axioms.Cong A C a c0) -> ((euclidean__defs.CongA B A C b a c0) -> ((euclidean__axioms.nCol b a c0) -> ((euclidean__defs.Out a c0 v) -> ((~(a = c0)) -> ((euclidean__axioms.neq c0 a) -> ((~(b = c0)) -> ((euclidean__axioms.neq c0 b) -> ((euclidean__axioms.Cong a c0 A C) -> ((euclidean__axioms.Cong a c0 a v) -> ((euclidean__axioms.neq a c0) -> ((c0 = c0) -> ((euclidean__defs.Out a c0 c0) -> (euclidean__axioms.Cong B C b v))))))))))))))) with (x := c).
----------------------------intro H47.
intro H48.
intro H49.
intro H50.
intro H51.
intro H52.
intro H53.
intro H54.
intro H55.
intro H56.
intro H57.
intro H58.
intro H59.
apply (@eq__ind__r euclidean__axioms.Point V (fun C0 => (euclidean__defs.CongA B A C0 b a v) -> ((euclidean__axioms.Cong A C0 a v) -> ((euclidean__defs.Out A C0 V) -> ((euclidean__axioms.nCol B A C0) -> ((~(euclidean__axioms.Col A B C0)) -> ((~(A = C0)) -> ((euclidean__axioms.neq C0 A) -> ((~(B = C0)) -> ((euclidean__axioms.neq C0 B) -> ((euclidean__axioms.Cong A C0 a v) -> ((euclidean__axioms.Cong a v A C0) -> (euclidean__axioms.Cong B C0 b v))))))))))))) with (x := C).
-----------------------------intro H60.
intro H61.
intro H62.
intro H63.
intro H64.
intro H65.
intro H66.
intro H67.
intro H68.
intro H69.
intro H70.
exact H35.

----------------------------- exact H39.
----------------------------- exact H48.
----------------------------- exact H47.
----------------------------- exact H10.
----------------------------- exact H21.
----------------------------- exact H24.
----------------------------- exact H26.
----------------------------- exact H27.
----------------------------- exact H32.
----------------------------- exact H33.
----------------------------- exact H40.
----------------------------- exact H55.

---------------------------- exact H46.
---------------------------- exact H0.
---------------------------- exact H1.
---------------------------- exact H2.
---------------------------- exact H14.
---------------------------- exact H28.
---------------------------- exact H29.
---------------------------- exact H30.
---------------------------- exact H31.
---------------------------- exact H41.
---------------------------- exact H42.
---------------------------- exact H43.
---------------------------- exact H44.
---------------------------- exact H45.
--------------------------- assert (* Cut *) (euclidean__axioms.Cong B C b c) as H48.
---------------------------- apply (@eq__ind__r euclidean__axioms.Point v (fun c0 => (euclidean__axioms.Cong A C a c0) -> ((euclidean__defs.CongA B A C b a c0) -> ((euclidean__axioms.nCol b a c0) -> ((euclidean__defs.Out a c0 v) -> ((~(a = c0)) -> ((euclidean__axioms.neq c0 a) -> ((~(b = c0)) -> ((euclidean__axioms.neq c0 b) -> ((euclidean__axioms.Cong a c0 A C) -> ((euclidean__axioms.Cong a c0 a v) -> ((euclidean__axioms.neq a c0) -> ((c0 = c0) -> ((euclidean__defs.Out a c0 c0) -> (euclidean__axioms.Cong B C b c0))))))))))))))) with (x := c).
-----------------------------intro H48.
intro H49.
intro H50.
intro H51.
intro H52.
intro H53.
intro H54.
intro H55.
intro H56.
intro H57.
intro H58.
intro H59.
intro H60.
apply (@eq__ind__r euclidean__axioms.Point V (fun C0 => (euclidean__defs.CongA B A C0 b a v) -> ((euclidean__axioms.Cong A C0 a v) -> ((euclidean__defs.Out A C0 V) -> ((euclidean__axioms.nCol B A C0) -> ((~(euclidean__axioms.Col A B C0)) -> ((~(A = C0)) -> ((euclidean__axioms.neq C0 A) -> ((~(B = C0)) -> ((euclidean__axioms.neq C0 B) -> ((euclidean__axioms.Cong A C0 a v) -> ((euclidean__axioms.Cong a v A C0) -> ((euclidean__axioms.Cong B C0 b v) -> (euclidean__axioms.Cong B C0 b v)))))))))))))) with (x := C).
------------------------------intro H61.
intro H62.
intro H63.
intro H64.
intro H65.
intro H66.
intro H67.
intro H68.
intro H69.
intro H70.
intro H71.
intro H72.
exact H72.

------------------------------ exact H39.
------------------------------ exact H49.
------------------------------ exact H48.
------------------------------ exact H10.
------------------------------ exact H21.
------------------------------ exact H24.
------------------------------ exact H26.
------------------------------ exact H27.
------------------------------ exact H32.
------------------------------ exact H33.
------------------------------ exact H40.
------------------------------ exact H56.
------------------------------ exact H47.

----------------------------- exact H46.
----------------------------- exact H0.
----------------------------- exact H1.
----------------------------- exact H2.
----------------------------- exact H14.
----------------------------- exact H28.
----------------------------- exact H29.
----------------------------- exact H30.
----------------------------- exact H31.
----------------------------- exact H41.
----------------------------- exact H42.
----------------------------- exact H43.
----------------------------- exact H44.
----------------------------- exact H45.
---------------------------- exact H48.
------------------- assert (* Cut *) (euclidean__axioms.Cong A C A C) as H40.
-------------------- apply (@euclidean__axioms.cn__congruencereflexive A C).
-------------------- assert (* Cut *) (euclidean__defs.Lt A C A V) as H41.
--------------------- exists C.
split.
---------------------- exact H39.
---------------------- exact H40.
--------------------- assert (* Cut *) (euclidean__defs.Lt A C a v) as H42.
---------------------- apply (@lemma__lessthancongruence.lemma__lessthancongruence A C A V a v H41 H18).
---------------------- assert (exists g, (euclidean__axioms.BetS a g v) /\ (euclidean__axioms.Cong a g A C)) as H43 by exact H42.
destruct H43 as [g H44].
destruct H44 as [H45 H46].
assert (* Cut *) (euclidean__axioms.neq a g) as H47.
----------------------- assert (* Cut *) ((euclidean__axioms.neq g v) /\ ((euclidean__axioms.neq a g) /\ (euclidean__axioms.neq a v))) as H47.
------------------------ apply (@lemma__betweennotequal.lemma__betweennotequal a g v H45).
------------------------ destruct H47 as [H48 H49].
destruct H49 as [H50 H51].
exact H50.
----------------------- assert (* Cut *) (euclidean__defs.Out a g v) as H48.
------------------------ apply (@lemma__ray4.lemma__ray4 a g v).
-------------------------right.
right.
exact H45.

------------------------- exact H47.
------------------------ assert (* Cut *) (euclidean__defs.Out a v g) as H49.
------------------------- apply (@lemma__ray5.lemma__ray5 a g v H48).
------------------------- assert (* Cut *) (euclidean__axioms.Cong a g a c) as H50.
-------------------------- apply (@lemma__congruencetransitive.lemma__congruencetransitive a g A C a c H46 H0).
-------------------------- assert (* Cut *) (euclidean__axioms.Cong a c a g) as H51.
--------------------------- apply (@lemma__congruencesymmetric.lemma__congruencesymmetric a a g c H50).
--------------------------- assert (* Cut *) (euclidean__defs.Out a v c) as H52.
---------------------------- apply (@lemma__ray5.lemma__ray5 a c v H14).
---------------------------- assert (* Cut *) (c = g) as H53.
----------------------------- apply (@lemma__layoffunique.lemma__layoffunique a v c g H52 H49 H51).
----------------------------- assert (* Cut *) (euclidean__axioms.BetS a c v) as H54.
------------------------------ apply (@eq__ind__r euclidean__axioms.Point g (fun c0 => (euclidean__axioms.Cong A C a c0) -> ((euclidean__defs.CongA B A C b a c0) -> ((euclidean__axioms.nCol b a c0) -> ((euclidean__defs.Out a c0 v) -> ((~(a = c0)) -> ((euclidean__axioms.neq c0 a) -> ((~(b = c0)) -> ((euclidean__axioms.neq c0 b) -> ((euclidean__axioms.Cong a g a c0) -> ((euclidean__axioms.Cong a c0 a g) -> ((euclidean__defs.Out a v c0) -> (euclidean__axioms.BetS a c0 v))))))))))))) with (x := c).
-------------------------------intro H54.
intro H55.
intro H56.
intro H57.
intro H58.
intro H59.
intro H60.
intro H61.
intro H62.
intro H63.
intro H64.
exact H45.

------------------------------- exact H53.
------------------------------- exact H0.
------------------------------- exact H1.
------------------------------- exact H2.
------------------------------- exact H14.
------------------------------- exact H28.
------------------------------- exact H29.
------------------------------- exact H30.
------------------------------- exact H31.
------------------------------- exact H50.
------------------------------- exact H51.
------------------------------- exact H52.
------------------------------ assert (* Cut *) (euclidean__axioms.Cong C V c v) as H55.
------------------------------- apply (@lemma__differenceofparts.lemma__differenceofparts A C V a c v H0 H18 H39 H54).
------------------------------- assert (* Cut *) (euclidean__axioms.Cong V B v b) as H56.
-------------------------------- assert (* Cut *) ((euclidean__axioms.Cong V B v b) /\ ((euclidean__axioms.Cong V B b v) /\ (euclidean__axioms.Cong B V v b))) as H56.
--------------------------------- apply (@lemma__congruenceflip.lemma__congruenceflip B V b v H35).
--------------------------------- destruct H56 as [H57 H58].
destruct H58 as [H59 H60].
exact H57.
-------------------------------- assert (* Cut *) (euclidean__axioms.Cong C B c b) as H57.
--------------------------------- apply (@lemma__interior5.lemma__interior5 A C V B a c v b H39 H54 H0 H55 H H56).
--------------------------------- assert (* Cut *) (euclidean__axioms.Cong B C b c) as H58.
---------------------------------- assert (* Cut *) ((euclidean__axioms.Cong B C b c) /\ ((euclidean__axioms.Cong B C c b) /\ (euclidean__axioms.Cong C B b c))) as H58.
----------------------------------- apply (@lemma__congruenceflip.lemma__congruenceflip C B c b H57).
----------------------------------- destruct H58 as [H59 H60].
destruct H60 as [H61 H62].
exact H59.
---------------------------------- exact H58.
----------------- assert (* Cut *) (A = A) as H38.
------------------ apply (@logic.eq__refl Point A).
------------------ assert (* Cut *) (C = C) as H39.
------------------- apply (@logic.eq__refl Point C).
------------------- assert (* Cut *) (a = a) as H40.
-------------------- apply (@logic.eq__refl Point a).
-------------------- assert (* Cut *) (c = c) as H41.
--------------------- apply (@logic.eq__refl Point c).
--------------------- assert (* Cut *) (B = B) as H42.
---------------------- apply (@logic.eq__refl Point B).
---------------------- assert (* Cut *) (b = b) as H43.
----------------------- apply (@logic.eq__refl Point b).
----------------------- assert (* Cut *) (euclidean__axioms.neq B A) as H44.
------------------------ apply (@lemma__inequalitysymmetric.lemma__inequalitysymmetric A B H25).
------------------------ assert (* Cut *) (euclidean__defs.Out B A A) as H45.
------------------------- apply (@lemma__ray4.lemma__ray4 B A A).
--------------------------right.
left.
exact H38.

-------------------------- exact H44.
------------------------- assert (* Cut *) (euclidean__defs.Out B C C) as H46.
-------------------------- apply (@lemma__ray4.lemma__ray4 B C C).
---------------------------right.
left.
exact H39.

--------------------------- exact H32.
-------------------------- assert (* Cut *) (euclidean__defs.Out b a a) as H47.
--------------------------- apply (@lemma__ray4.lemma__ray4 b a a).
----------------------------right.
left.
exact H40.

---------------------------- exact H23.
--------------------------- assert (* Cut *) (euclidean__defs.Out b c c) as H48.
---------------------------- apply (@lemma__ray4.lemma__ray4 b c c).
-----------------------------right.
left.
exact H41.

----------------------------- exact H30.
---------------------------- assert (* Cut *) (euclidean__axioms.Cong B A b a) as H49.
----------------------------- assert (* Cut *) ((euclidean__axioms.Cong B A b a) /\ ((euclidean__axioms.Cong B A a b) /\ (euclidean__axioms.Cong A B b a))) as H49.
------------------------------ apply (@lemma__congruenceflip.lemma__congruenceflip A B a b H).
------------------------------ destruct H49 as [H50 H51].
destruct H51 as [H52 H53].
exact H50.
----------------------------- assert (* Cut *) (euclidean__defs.CongA A B C a b c) as H50.
------------------------------ exists A.
exists C.
exists a.
exists c.
split.
------------------------------- exact H45.
------------------------------- split.
-------------------------------- exact H46.
-------------------------------- split.
--------------------------------- exact H47.
--------------------------------- split.
---------------------------------- exact H48.
---------------------------------- split.
----------------------------------- exact H49.
----------------------------------- split.
------------------------------------ exact H37.
------------------------------------ split.
------------------------------------- exact H0.
------------------------------------- apply (@euclidean__tactics.nCol__notCol A B C H24).
------------------------------ assert (* Cut *) (euclidean__defs.Out C A A) as H51.
------------------------------- apply (@lemma__ray4.lemma__ray4 C A A).
--------------------------------right.
left.
exact H38.

-------------------------------- exact H27.
------------------------------- assert (* Cut *) (euclidean__defs.Out C B B) as H52.
-------------------------------- apply (@lemma__ray4.lemma__ray4 C B B).
---------------------------------right.
left.
exact H42.

--------------------------------- exact H33.
-------------------------------- assert (* Cut *) (euclidean__defs.Out c a a) as H53.
--------------------------------- apply (@lemma__ray4.lemma__ray4 c a a).
----------------------------------right.
left.
exact H40.

---------------------------------- exact H29.
--------------------------------- assert (* Cut *) (euclidean__defs.Out c b b) as H54.
---------------------------------- apply (@lemma__ray4.lemma__ray4 c b b).
-----------------------------------right.
left.
exact H43.

----------------------------------- exact H31.
---------------------------------- assert (* Cut *) (euclidean__axioms.Cong C A c a) as H55.
----------------------------------- assert (* Cut *) ((euclidean__axioms.Cong C A c a) /\ ((euclidean__axioms.Cong C A a c) /\ (euclidean__axioms.Cong A C c a))) as H55.
------------------------------------ apply (@lemma__congruenceflip.lemma__congruenceflip A C a c H0).
------------------------------------ destruct H55 as [H56 H57].
destruct H57 as [H58 H59].
exact H56.
----------------------------------- assert (* Cut *) (euclidean__axioms.Cong C B c b) as H56.
------------------------------------ assert (* Cut *) ((euclidean__axioms.Cong C B c b) /\ ((euclidean__axioms.Cong C B b c) /\ (euclidean__axioms.Cong B C c b))) as H56.
------------------------------------- apply (@lemma__congruenceflip.lemma__congruenceflip B C b c H37).
------------------------------------- destruct H56 as [H57 H58].
destruct H58 as [H59 H60].
exact H57.
------------------------------------ assert (* Cut *) (~(euclidean__axioms.Col A C B)) as H57.
------------------------------------- intro H57.
assert (* Cut *) (euclidean__axioms.Col A B C) as H58.
-------------------------------------- assert (* Cut *) ((euclidean__axioms.Col C A B) /\ ((euclidean__axioms.Col C B A) /\ ((euclidean__axioms.Col B A C) /\ ((euclidean__axioms.Col A B C) /\ (euclidean__axioms.Col B C A))))) as H58.
--------------------------------------- apply (@lemma__collinearorder.lemma__collinearorder A C B H57).
--------------------------------------- destruct H58 as [H59 H60].
destruct H60 as [H61 H62].
destruct H62 as [H63 H64].
destruct H64 as [H65 H66].
exact H65.
-------------------------------------- apply (@H24 H58).
------------------------------------- assert (* Cut *) (euclidean__defs.CongA A C B a c b) as H58.
-------------------------------------- exists A.
exists B.
exists a.
exists b.
split.
--------------------------------------- exact H51.
--------------------------------------- split.
---------------------------------------- exact H52.
---------------------------------------- split.
----------------------------------------- exact H53.
----------------------------------------- split.
------------------------------------------ exact H54.
------------------------------------------ split.
------------------------------------------- exact H55.
------------------------------------------- split.
-------------------------------------------- exact H56.
-------------------------------------------- split.
--------------------------------------------- exact H.
--------------------------------------------- apply (@euclidean__tactics.nCol__notCol A C B H57).
-------------------------------------- split.
--------------------------------------- exact H37.
--------------------------------------- split.
---------------------------------------- exact H50.
---------------------------------------- exact H58.
Qed.


Require Import FCF.FCF.
Require Import FCF.Asymptotic.
Require Import RatUtil.
Require Import Coq.Lists.SetoidList.

Global Instance Proper_negligible :
  Proper (pointwise_relation nat eqRat ==> iff) negligible.
Proof.
  cbv [pointwise_relation Proper respectful].
  split; eauto 10 using negligible_eq, (@symmetry _ eqRat _).
Qed.

Global Instance Proper_negligible_le :
  Proper (pointwise_relation nat leRat ==> Basics.flip Basics.impl) negligible.
Proof.
  cbv [pointwise_relation Proper respectful].
  intros ? ? ? ?; eauto using negligible_le.
Qed.

Lemma negligible_0 : negligible (fun _ => 0).
  eapply negligible_le with (f1 := fun n => 0 / expnat 2 n).
  { reflexivity. }
  { apply negligible_const_num. }
Qed.

Definition image_relation {T} (R:T->T->Prop) {A} (f:A->T) := fun x y => R (f x) (f y).
Global Instance Equivalence_image_relation {T R} {Equivalence_R:Equivalence R} {A} (f:A->T) :
  Equivalence (image_relation R f).
Proof. destruct Equivalence_R; split; cbv; eauto. Qed.

Definition Comp_eq {A} := image_relation (pointwise_relation _ eqRat) (@evalDist A).
Global Instance Equivalence_Comp_eq {A} : Equivalence (@Comp_eq A) := _.

Global Instance Proper_evalDist {A} : Proper (Comp_eq ==> Logic.eq ==> eqRat) (@evalDist A).
Proof. intros ?? H ?? ?; subst; apply H. Qed.

Global Instance Proper_getSupport {A} : Proper (Comp_eq ==> (@Permutation.Permutation _)) (@getSupport A).
Proof. intros ???; eapply evalDist_getSupport_perm_id; assumption. Qed.

Global Instance Proper_sumList {A:Set} {R:A->A->Prop} : Proper (eqlistA R  ==> (R ==> eqRat) ==> eqRat) (@sumList A).
Proof.
  repeat intro. cbv [sumList].
  rewrite <-!fold_left_rev_right.
  eapply eqlistA_rev in H.
  generalize dependent (rev x); generalize dependent (rev y).
  intros ? ?; induction 1; [reflexivity|].
  simpl; f_equiv; eauto.
Qed.

Global Instance Proper_sumList_permutation {A:Set} : Proper ((@Permutation.Permutation A) ==> (pointwise_relation _ eqRat) ==> eqRat) (@sumList A).
Proof.
  intros ? ? H; induction H; repeat intro; cbv [respectful] in *; rewrite ?sumList_cons.
  { eauto with rat. }
  { f_equiv; eauto. }
  { cbv [pointwise_relation] in H; repeat rewrite H.
    repeat rewrite <-ratAdd_assoc.
    rewrite (ratAdd_comm (y0 y)).
    f_equiv.
    eapply (Proper_sumList(R:=Logic.eq)); eauto; repeat intro; subst; auto; reflexivity. }
  { etransitivity; [eapply IHPermutation1 | eapply IHPermutation2];
      intros; subst; (try match goal with H1:_ |- _ => eapply H1 end;reflexivity). }
Qed.

Global Instance Proper_Bind {A B} : Proper (Comp_eq ==> (pointwise_relation _ Comp_eq) ==> Comp_eq) (@Bind A B).
Proof.
  intros ?? H ?? G ?. simpl evalDist.
  setoid_rewrite H. setoid_rewrite G. reflexivity.
Qed.

Lemma eq_impl_negligible : forall A (x y : nat -> Comp A), pointwise_relation _ Comp_eq x y -> forall t, negligible (fun eta : nat => | evalDist (x eta) t - evalDist (y eta) t|).
Admitted.

Lemma Comp_eq_bool (x y:Comp bool) :
  well_formed_comp x
  -> well_formed_comp y
  -> Pr [x] == Pr[y]
  -> Comp_eq x y.
  intros.
  intro b.
  destruct b; trivial.
  rewrite !evalDist_complement; trivial.
  f_equiv; trivial.
Qed.

Lemma Comp_eq_evalDist A (x y:Comp A) :
  (forall c, evalDist x c == evalDist y c)
  <-> Comp_eq x y.
Proof.
  split; intro.
  { cbv [Comp_eq pointwise_relation image_relation]; assumption. }
  { cbv [Comp_eq pointwise_relation image_relation] in H; assumption. }
Qed.

(* TODO: This should be a two-way lemma *)
Lemma comp_spec_impl_Comp_eq A (H: EqDec A) (x y: Comp A) :
  comp_spec eq x y
  -> Comp_eq x y.
Proof.
  intro.
  apply Comp_eq_evalDist.
  intro.
  fcf_to_prhl.
  cbv [comp_spec] in *.
  destruct H0.
  exists x0.
  destruct H0.
  destruct H1.
  split; try split; try assumption.
  intros.
  specialize (H2 p H3).
  rewrite H2.
  reflexivity.
Qed.

Lemma Bind_unused A B (a:Comp A) (b:Comp B) :
  Comp_eq (_ <-$ a; b) b.
Admitted. (* TODO: does FCF have something like this? *)

Lemma Bind_Ret_l {A B: Set} {H: EqDec A} (x: A) (f: A -> Comp B):
  Comp_eq (x' <-$ ret x; f x') (f x).
Proof.
  apply Comp_eq_evalDist.
  intros.
  apply evalDist_left_ident_eq.
Qed.

Lemma Bind_Ret_r {A : Set} {H: EqDec A} (cA : Comp A) :
  Comp_eq (x <-$ cA; ret x) cA.
Proof.
  apply Comp_eq_evalDist.
  intros.
  apply evalDist_right_ident.
Qed.

Lemma Bind_assoc {A B C: Set} (cA : Comp A)
      (f : A -> Comp B) (g : B -> Comp C) :
  Comp_eq (x <-$ cA; y <-$ f x; g y) (y <-$ (x <-$ cA; f x); g y).
Proof.
  intros.
  apply Comp_eq_evalDist.
  intros.
  fcf_inline_first.
  reflexivity.
Qed.

Lemma Bind_comm : forall (A B : Set)(c1 : Comp A)(c2 : Comp B)(C : Set)(c3 : A -> B -> Comp C),
  Comp_eq (a <-$ c1; b <-$ c2; (c3 a b)) (b <-$ c2; a <-$ c1; (c3 a b)).
Proof.
  intros.
  apply Comp_eq_evalDist.
  intros.
  apply evalDist_commute_eq.
Qed.


Require Import Coq.Logic.Classical_Prop.
Require Import Logic.lib.Ensembles_ext.
Require Import Logic.GeneralLogic.Base.
Require Import Logic.GeneralLogic.KripkeModel.
Require Import Logic.GeneralLogic.Semantics.Kripke.
Require Import Logic.MinimumLogic.Syntax.
Require Import Logic.MinimumLogic.ProofTheory.Minimum.
Require Import Logic.MinimumLogic.Semantics.Kripke.
Require Logic.MinimumLogic.Sound.Sound_Kripke.
Require Logic.MinimumLogic.DeepEmbedded.MinimumLanguage.
Require Logic.MinimumLogic.DeepEmbedded.MinimumLogic.
Require Logic.MinimumLogic.DeepEmbedded.KripkeSemantics.

Local Open Scope logic_base.
Local Open Scope syntax.
Local Open Scope kripke_model.
Local Open Scope kripke_model_class.
Import KripkeModelFamilyNotation.
Import KripkeModelNotation_Intuitionistic.
Import KripkeModelClass.

(* TODO: soundness about trivial semantics is not yet added. *)

Section Sound.

Context (Var: Type).

Instance L: Language := MinimumLanguage.L Var.
Instance minL: MinimumLanguage L := MinimumLanguage.minL Var.

Instance GP: Provable L := MinimumLogic.GP Var.
Instance GD: Derivable L := MinimumLogic.GD Var.
Instance GDP: DerivableProvable L GP GD := MinimumLogic.GDP Var.
Instance minAX: MinimumAxiomatization L GP := MinimumLogic.minAX Var.

Instance Kripke_MD: Model := KripkeSemantics.MD Var.
Instance Kripke_kMD: KripkeModel Kripke_MD := KripkeSemantics.kMD Var.
Instance Kripke_R (M: Kmodel): Relation (Kworlds M) := KripkeSemantics.R Var M.
Instance Kripke_SM: Semantics L Kripke_MD := KripkeSemantics.SM Var.
Instance Kripke_kminSM (M: Kmodel): KripkeMinimumSemantics L Kripke_MD M Kripke_SM := KripkeSemantics.kminSM Var M.

Section Sound_Kripke.

Import Logic.MinimumLogic.Sound.Sound_Kripke.
Import Logic.MinimumLogic.DeepEmbedded.KripkeSemantics.

Theorem sound_intuitionistic_Kripke_all:
  provable_sound GP Kripke_SM (KripkeModelClass _ (Kmodel_Monotonic + Kmodel_PreOrder)).
Proof.
  hnf; intros.
  intros _ [M m [mono po_R]].
  pose proof (@KripkeSemantics.kiSM Var M mono po_R) as kiSM.
  hnf in mono, po_R.
  change (Kmodel Var) in M.
  change (Kworlds M) in m.
  change (KRIPKE: M, m |= x).
  induction H.
  + pose proof sound_modus_ponens x y m.
    exact (H1 IHprovable1 IHprovable2).
  + apply sound_axiom1.
  + apply sound_axiom2.
Qed.

End Sound_Kripke.

End Sound.


Require Import UniMath.Foundations.Generalities.uu0.
Require Import UniMath.Foundations.hlevel1.hProp.
Require Import UniMath.Foundations.hlevel2.hSet.

Require Import UniMath.RezkCompletion.precategories.
Require Import UniMath.RezkCompletion.functor_categories.
Require Import SubstSystems.UnicodeNotations.
Require Import UniMath.RezkCompletion.whiskering.
Require Import UniMath.RezkCompletion.Monads.
Require Import UniMath.RezkCompletion.limits.products.
Require Import UniMath.RezkCompletion.limits.coproducts.
Require Import UniMath.RezkCompletion.limits.terminal.
Require Import SubstSystems.Auxiliary.
Require Import SubstSystems.PointedFunctors.
Require Import SubstSystems.ProductPrecategory.
Require Import SubstSystems.HorizontalComposition.
Require Import SubstSystems.PointedFunctorsComposition.
Require Import SubstSystems.Signatures.
(* Require Import SubstSystems.SubstitutionSystems. *)
Require Import SubstSystems.FunctorsPointwiseCoproduct.
Require Import SubstSystems.FunctorsPointwiseProduct.
Require Import SubstSystems.EndofunctorsMonoidal.
Require Import SubstSystems.SumOfSignatures.

Local Notation "# F" := (functor_on_morphisms F)(at level 3).
Local Notation "F ⟶ G" := (nat_trans F G) (at level 39).
Arguments functor_composite {_ _ _} _ _ .
Arguments nat_trans_comp {_ _ _ _ _} _ _ .
Local Notation "G ∙ F" := (functor_composite F G : [ _ , _ , _ ]) (at level 35).
Local Notation "α ∙∙ β" := (hor_comp β α) (at level 20).
Ltac pathvia b := (apply (@pathscomp0 _ _ b _ )).

Local Notation "α 'ø' Z" := (pre_whisker Z α)  (at level 25).
Local Notation "Z ∘ α" := (post_whisker _ _ _ _ α Z) (at level 35).

Arguments θ_source {_ _} _ .
Arguments θ_target {_ _} _ .
Arguments θ_Strength1 {_ _ _} _ .
Arguments θ_Strength2 {_ _ _} _ .

Section Preparations.

Variable C : precategory.
Variable hs : has_homsets C.
Variable CP : Products C.
Variable CC : Coproducts C.
Variable terminal : Terminal C.
Let one : C :=  @TerminalObject C terminal.

Definition square_functor := product_functor C C CP (functor_identity C) (functor_identity C).

Definition option_functor: functor C C := coproduct_functor _ _ CC (constant_functor _ _  one) (functor_identity C).

End Preparations.

Section Lambda.

Variable C : precategory.
Variable hs : has_homsets C.

(** The category of endofunctors on [C] *)
Local Notation "'EndC'":= ([C, C, hs]) .

Variable terminal : Terminal C.

Variable CC : Coproducts C.
Variable CP : Products C.

Let one : C :=  @TerminalObject C terminal.

(**
   [App_H (X) (A) :=  X(A) × X(A)]
*)
Definition App_H : functor EndC EndC.
Proof.
  apply square_functor.
  apply Products_functor_precat.
  exact CP.
Defined.

(**
   [Abs_H (X) := X o option]
*)

Definition Abs_H_ob (X: EndC): functor C C := functor_composite (option_functor _ CC terminal) X.

(* works only with -type-in-type:
Definition Abs_H_mor_nat_trans_data (X X': EndC)(α: X ⇒ X'): ∀ c, Abs_H_ob X c ⇒ Abs_H_ob X' c.
Proof.
  intro.
  unfold Abs_H_ob.
  red. simpl. apply α.
Defined.
*)

Definition Abs_H_mor_nat_trans_data (X X': functor C C)(α: nat_trans X X'): ∀ c, Abs_H_ob X c ⇒ Abs_H_ob X' c.
Proof.
  intro.
  apply α.
Defined.

Lemma is_nat_trans_Abs_H_mor_nat_trans_data  (X X': EndC)(α: X ⇒ X'): is_nat_trans _ _ (Abs_H_mor_nat_trans_data X X' α).
Proof.
  red.
  intros c c' f.
  destruct α as [α α_nat_trans].
  unfold Abs_H_mor_nat_trans_data, Abs_H_ob.
  simpl.
  apply α_nat_trans.
 Qed.

Definition Abs_H_mor (X X': EndC)(α: X ⇒ X'): (Abs_H_ob X: ob EndC) ⇒ Abs_H_ob X'.
Proof.
  exists (Abs_H_mor_nat_trans_data X X' α).
  exact (is_nat_trans_Abs_H_mor_nat_trans_data X X' α).
Defined.

Definition Abs_H_functor_data: functor_data EndC EndC.
Proof.
  exists Abs_H_ob.
  exact Abs_H_mor.
Defined.

Lemma is_functor_Abs_H_data: is_functor Abs_H_functor_data.
Proof.
  red.
  split; red.
  + intros X.
    unfold Abs_H_functor_data.
    simpl.
    apply nat_trans_eq; try assumption.
    intro c.
    unfold Abs_H_mor.
    simpl.
    apply idpath.
  + intros X X' X'' α β.
    unfold Abs_H_functor_data.
    simpl.
    apply nat_trans_eq; try assumption.
    intro c.
    unfold Abs_H_mor.
    simpl.
    apply idpath.
Qed.

Definition Abs_H : functor [C, C, hs] [C, C, hs] := tpair _ _ is_functor_Abs_H_data.

(**
   [Flat_H (X) := X o X]

   ingredients:
     - functor_composite in RezkCompletion.functor_categories
     - map given by horizontal composition in Substsystems.HorizontalComposition

 Alternatively : free in two arguments, then precomposed with diagonal

*)
Definition Flat_H_ob (X: EndC): functor C C := functor_composite X X.
Definition Flat_H_mor (X X': EndC)(α: X ⇒ X'): (Flat_H_ob X: EndC) ⇒ Flat_H_ob X' := α ∙∙ α.
Definition Flat_H_functor_data: functor_data EndC EndC.
Proof.
  exists Flat_H_ob.
  exact Flat_H_mor.
Defined.

Lemma is_functor_Flat_H_data: is_functor Flat_H_functor_data.
Proof.
  red.
  split; red.
  + intros X.
    unfold Flat_H_functor_data.
    simpl.
    unfold Flat_H_mor.
    apply nat_trans_eq; try assumption.
    intro c.
    simpl.
    rewrite id_left.
    apply functor_id.
  + intros X X' X'' α β.
    unfold Flat_H_functor_data.
    simpl.
    unfold Flat_H_mor.
    apply nat_trans_eq; try assumption.
    intro c.
    simpl.
    rewrite functor_comp.
    repeat rewrite <- assoc.
    apply maponpaths.
    repeat rewrite assoc.
    rewrite (nat_trans_ax β).
    apply idpath.
Qed.

Definition Flat_H : functor [C, C, hs] [C, C, hs] := tpair _ _ is_functor_Flat_H_data.

(** here definition of suitable θ's together with their strength laws  *)

Definition App_θ_data: ∀ XZ, (θ_source App_H)XZ ⇒ (θ_target App_H)XZ.
Proof.
  intro XZ.
  apply nat_trans_id.
Defined.

Lemma is_nat_trans_App_θ_data: is_nat_trans _ _ App_θ_data.
Proof.
  red.
  unfold App_θ_data.
  intros XZ XZ' αβ.
(* the following only for better readability: *)
  destruct XZ as [X Z];
  destruct XZ' as [X' Z'];
  destruct αβ as [α β];
  simpl in *.
  apply nat_trans_eq; try assumption.
  intro c.
  simpl.
  rewrite id_left.
  rewrite id_right.
  unfold product_nat_trans_data, product_functor_mor.
  unfold ProductOfArrows.
  eapply pathscomp0.
  apply precompWithProductArrow.
  simpl.
  unfold product_nat_trans_pr1_data. unfold product_nat_trans_pr2_data.
  simpl.
  apply ProductArrowUnique.
  + rewrite ProductPr1Commutes.
    repeat rewrite assoc.
    rewrite ProductPr1Commutes.
    apply idpath.
  + rewrite ProductPr2Commutes.
    repeat rewrite assoc.
    rewrite ProductPr2Commutes.
    apply idpath.
Qed.

Definition App_θ: nat_trans (θ_source App_H) (θ_target App_H) :=
  tpair _ _ is_nat_trans_App_θ_data.

Lemma App_θ_strenght1_int: θ_Strength1_int App_θ.
Proof.
  red.
  intro.
  unfold App_θ, App_H.
  simpl.
  unfold App_θ_data.
  apply nat_trans_eq; try assumption.
  intro c.
  simpl.
  rewrite id_left.
  unfold product_nat_trans_data.
  apply pathsinv0.
  apply ProductArrowUnique.
  + rewrite id_left.
    unfold EndofunctorsMonoidal.λ_functor.
    unfold EndofunctorsMonoidal.ρ_functor.
    simpl.
    rewrite id_right.
    apply idpath.
  + rewrite id_left.
    unfold EndofunctorsMonoidal.λ_functor.
    unfold EndofunctorsMonoidal.ρ_functor.
    simpl.
    rewrite id_right.
    apply idpath.
Qed.

Lemma App_θ_strenght2_int: θ_Strength2_int App_θ.
Proof.
  red.
  intros.
  unfold App_θ, App_H.
  simpl.
  unfold App_θ_data.
  apply nat_trans_eq; try assumption.
  intro c.
  simpl.
  do 3 rewrite id_left.
  unfold product_nat_trans_data.
  apply pathsinv0.
  apply ProductArrowUnique.
  + rewrite id_left.
    unfold EndofunctorsMonoidal.α_functor.
    simpl.
    rewrite id_right.
    apply idpath.
  + rewrite id_left.
    unfold EndofunctorsMonoidal.α_functor.
    simpl.
    rewrite id_right.
    apply idpath.
Qed.

Definition Abs_θ_data_data: ∀ XZ A, ((θ_source Abs_H)XZ: functor C C) A ⇒ ((θ_target Abs_H)XZ: functor C C) A.
Proof.
  intro XZ.
(*
  destruct XZ as [X Z].
*)
  simpl.
  intro A.
  apply (functor_on_morphisms (functor_data_from_functor _ _ (pr1 XZ))).
  unfold coproduct_functor_ob.
  unfold constant_functor.
  simpl.
(*
  destruct Z as [Z e].
*)
  simpl.
  apply CoproductArrow.
  + exact (CoproductIn1 _ _ ;; nat_trans_data (pr2 (pr2 XZ)) (CoproductObject C (CC terminal A))).
  + exact (# (pr1 (pr2 XZ)) (CoproductIn2 _ (CC terminal A))).
Defined.

Lemma is_nat_trans_Abs_θ_data_data: ∀ XZ, is_nat_trans _ _ (Abs_θ_data_data XZ).
Proof.

  intro XZ.
  intros c c' f.
  unfold Abs_θ_data_data.
  simpl.
  rewrite <- functor_comp.
  rewrite <- functor_comp.
  apply maponpaths.
  unfold coproduct_functor_mor.
  eapply pathscomp0.
  apply precompWithCoproductArrow.
  eapply pathscomp0.
Focus 2.
  apply (!(postcompWithCoproductArrow _ _ _ _ _)).
  simpl.
  rewrite id_left.
  rewrite <- assoc.
  rewrite <- functor_comp.
  rewrite <- functor_comp.
  simpl.
  apply CoproductArrow_eq.
  + assert (NN :=  nat_trans_ax (pr2 (pr2 XZ)) _ _ (CoproductOfArrows C (CC terminal c) (CC terminal c')
         (identity terminal) f)).
    match goal with |[ H1: _ = ?f;;?g |- _ = ?h ;; _ ] =>
         pathvia (h;;(f;;g)) end.
    * rewrite <- NN.
      clear NN.
      unfold functor_identity.
      simpl.
      rewrite assoc.
      rewrite CoproductOfArrowsIn1.
      rewrite id_left.
      apply idpath.
    * apply idpath.
  + apply maponpaths.
    eapply pathscomp0.
Focus 2.
    apply (!(CoproductOfArrowsIn2 _ _ _ _ _ )).
    apply idpath.

(*
  intros [X [Z e]].
  red.
  intros c c' f.
  simpl.
  rewrite <- functor_comp.
  rewrite <- functor_comp.
  apply maponpaths.
  unfold coproduct_functor_mor.
  eapply pathscomp0.
  apply precompWithCoproductArrow.
  eapply pathscomp0.
Focus 2.
  apply (!(postcompWithCoproductArrow _ _ _ _ _)).
  simpl.
  rewrite id_left.
  rewrite <- assoc.
  rewrite <- functor_comp.
  rewrite <- functor_comp.
  simpl.
  apply CoproductArrow_eq.
  + assert (NN :=  nat_trans_ax e _ _ (CoproductOfArrows C (CC terminal c) (CC terminal c')
         (identity terminal) f)).
    match goal with |[ H1: _ = ?f;;?g |- _ = ?h ;; _ ] =>
         pathvia (h;;(f;;g)) end.
    * rewrite <- NN.
      clear NN.
      unfold functor_identity.
      simpl.
      rewrite assoc.
      rewrite CoproductOfArrowsIn1.
      rewrite id_left.
      apply idpath.
    * apply idpath.
  + apply maponpaths.
    eapply pathscomp0.
Focus 2.
    apply (!(CoproductOfArrowsIn2 _ _ _ _ _ )).
    apply idpath.
*)
Qed.

Definition Abs_θ_data: ∀ XZ, (θ_source Abs_H)XZ ⇒ (θ_target Abs_H)XZ.
Proof.
  intro XZ.
  exact (tpair _ _ (is_nat_trans_Abs_θ_data_data XZ)).
Defined.

Lemma is_nat_trans_Abs_θ_data: is_nat_trans _ _ Abs_θ_data.
Proof.
  red.
  intros XZ XZ' αβ.
  destruct XZ as [X [Z e]].
  destruct XZ' as [X' [Z' e']].
  destruct αβ as [α β].
  simpl in *.
  apply nat_trans_eq; try assumption.
  intro c.
  simpl.
  simpl in *.
  unfold constant_functor.
  unfold coproduct_functor_ob.
  simpl.
  rewrite assoc.
  unfold Abs_θ_data_data. simpl.
  rewrite (nat_trans_ax α).
  do 2 rewrite <- assoc.
  apply maponpaths.
  do 2 rewrite <- functor_comp.
  apply maponpaths.
  unfold coproduct_functor_mor, constant_functor_data.
  simpl.
  eapply pathscomp0. apply precompWithCoproductArrow.
(*  rewrite precompWithCoproductArrow. *)
  eapply pathscomp0. Focus 2. eapply pathsinv0.
  apply postcompWithCoproductArrow.
(*
  eapply cancel_postcomposition. apply postcompWithCoproductArrow.
*)
(*  rewrite postcompWithCoproductArrow. *)
  apply CoproductArrow_eq.
  + rewrite id_left.
    rewrite <- assoc.
    rewrite <- (ptd_mor_commutes _ β).
    apply idpath.
  + simpl in *.
    apply pathsinv0.
    apply (nat_trans_ax β).
Qed.

Definition Abs_θ: nat_trans (θ_source Abs_H) (θ_target Abs_H) :=
  tpair _ _ is_nat_trans_Abs_θ_data.

Lemma Abs_θ_strenght1_int: θ_Strength1_int Abs_θ.
Proof.
  red.
  intro.
  unfold Abs_θ, Abs_H.
  simpl.
  unfold Abs_θ_data.
  apply nat_trans_eq; try assumption.
  intro c.
  simpl.
  rewrite id_right.
  apply functor_id_id.
  apply pathsinv0.
  apply CoproductArrowUnique.
  + apply idpath.
  + apply id_right.
Qed.

Lemma Abs_θ_strenght2_int: θ_Strength2_int Abs_θ.
Proof.
  red.
  intros.
  unfold Abs_θ, Abs_H.
  simpl.
  unfold Abs_θ_data.
  apply nat_trans_eq; try assumption.
  intro c.
  simpl.
  rewrite id_left.
  rewrite id_right.
  unfold Abs_θ_data_data. simpl.
  rewrite <- functor_comp.
  apply maponpaths.
  clear X.
  destruct Z as [Z e];
  destruct Z' as [Z' e'];
  simpl.
  eapply pathscomp0.
Focus 2.
  eapply pathsinv0.
  apply postcompWithCoproductArrow.
  simpl in *.
  apply CoproductArrow_eq.
  + rewrite <- assoc.
    assert (NN := nat_trans_ax e' _ _ (e (CoproductObject C (CC terminal c)))).
    simpl in NN. (* is important for success of the trick *)
    match goal with |[ H1: _ = ?f;;?g |- ?h ;; _ = _ ] =>
         pathvia (h;;(f;;g)) end.
    * apply idpath.
    * simpl. rewrite <- NN.
      clear NN.
      assert (NNN := nat_trans_ax e' _ _ (CoproductArrow C (CC terminal (Z c))
         (CoproductIn1 C (CC terminal c);;
          e (CoproductObject C (CC terminal c)))
         (# Z (CoproductIn2 C (CC terminal c))))).
      simpl in NNN.
      match goal with |[ H1: _ = ?f;;?g |- _ = ?h ;; _] =>
         pathvia (h;;(f;;g)) end.
      - simpl. rewrite <- NNN.
        clear NNN.
        do 2 rewrite assoc.
        rewrite CoproductIn1Commutes.
        apply idpath.
      - apply idpath.
  + rewrite <- functor_comp.
    apply maponpaths.
    eapply pathscomp0.
Focus 2.
    eapply pathsinv0.
    apply CoproductIn2Commutes.
    apply idpath.
Qed.

Definition Flat_θ_data: ∀ XZ, (θ_source Flat_H)XZ ⇒ (θ_target Flat_H)XZ.
Proof.
  intro XZ.
(*  destruct XZ as [X [Z e]].
  simpl.
*)
  set (h:= nat_trans_comp (λ_functor_inv _ (pr1 XZ)) ((nat_trans_id _) ∙∙ (pr2 (pr2 XZ)))).
  exact (nat_trans_comp (α_functor_inv _ (pr1 (pr2 XZ)) (pr1 XZ) (pr1 XZ)) (h ∙∙ (nat_trans_id (functor_composite (pr1 (pr2 XZ)) (pr1 XZ))))).
Defined.

Lemma is_nat_trans_Flat_θ_data: is_nat_trans _ _ Flat_θ_data.
Proof.
  red.
  intros XZ XZ' αβ.
  apply nat_trans_eq; try assumption.
  intro c.
  simpl.
  destruct XZ as [X [Z e]];
  destruct XZ' as [X' [Z' e']];
  destruct αβ as [α β];
  simpl in *.
  repeat rewrite id_left.
  do 4 rewrite functor_id.
  do 2 rewrite id_right.
  repeat rewrite <- assoc.
  do 3 rewrite <- functor_comp.
  repeat rewrite assoc.
  rewrite (nat_trans_ax α).
  repeat rewrite <- assoc.
  apply maponpaths.
  rewrite <- functor_comp.
  apply maponpaths.
  repeat rewrite assoc.
  assert (β_is_pointed := ptd_mor_commutes _ β).
  simpl in β_is_pointed.
  rewrite β_is_pointed.
  simpl.
  eapply pathscomp0.
Focus 2.
  apply (nat_trans_ax e').
  apply idpath.
Qed.

Definition Flat_θ: nat_trans (θ_source Flat_H) (θ_target Flat_H) :=
  tpair _ _ is_nat_trans_Flat_θ_data.

Lemma Flat_θ_strenght1_int: θ_Strength1_int Flat_θ.
Proof.
  red.
  intro.
  unfold Flat_θ, Flat_H.
  simpl.
  apply nat_trans_eq; try assumption.
  intro c.
  simpl.
  repeat rewrite id_left.
  repeat rewrite functor_id.
  repeat rewrite id_left.
  apply idpath.
Qed.

Lemma Flat_θ_strenght2_int: θ_Strength2_int Flat_θ.
Proof.
  red.
  intros.
  destruct Z as [Z e];
  destruct Z' as [Z' e'];
  simpl.
  apply nat_trans_eq; try assumption.
  intro c.
  simpl.
  repeat rewrite id_left.
  repeat rewrite <- functor_comp.
  apply maponpaths.
  repeat rewrite functor_id.
  repeat rewrite id_right.
  apply idpath.
Qed.

(** finally, constitute the 3 signatures *)

Definition App_Sig: Signature C hs.
Proof.
  exists App_H.
  exists App_θ.
  split.
  + exact App_θ_strenght1_int.
  + exact App_θ_strenght2_int.
Defined.

Definition Abs_Sig: Signature C hs.
Proof.
  exists Abs_H.
  exists Abs_θ.
  split.
  + exact Abs_θ_strenght1_int.
  + exact Abs_θ_strenght2_int.
Defined.

Definition Flat_Sig: Signature C hs.
Proof.
  exists Flat_H.
  exists Flat_θ.
  split.
  + exact Flat_θ_strenght1_int.
  + exact Flat_θ_strenght2_int.
Defined.

Definition Lam_Sig: Signature C hs :=
  Sum_of_Signatures C hs CC App_Sig Abs_Sig.

Definition LamE_Sig: Signature C hs :=
  Sum_of_Signatures C hs CC Lam_Sig Flat_Sig.

End Lambda.


Load LFindLoad.
From lfind Require Import LFind.
From QuickChick Require Import QuickChick.
From adtind Require Import goal33.

Derive Show for natural.

              Derive Arbitrary for natural.

              Instance Dec_Eq_natural : Dec_Eq natural.

              Proof. dec_eq. Qed.

Lemma conj13eqsynthconj1 : forall  (lv0 : natural) (lv1 : natural) (lv2 : natural), (@eq natural (plus (plus (mult lv0 lv1) lv1) lv2) (plus lv1 (plus lv2 (mult lv0 lv1)))).
Admitted.
QuickChick conj13eqsynthconj1.


Require Import AB.Imp9.
Require Import AB.HoareLogic.

Import Assertion_D.
Import Abstract_Pretty_Printing.
Import Hoare_Logic.

Definition FOL_valid (P: Assertion): Prop :=
  forall J: Interp, J |== P.

Instance TrivialFOL: FirstOrderLogic :=
  {| FOL_provable := (fun P => FOL_valid P) |}.

Lemma convert_IMPLY : forall (P Q : Prop), (P -> Q) -> ~P \/ Q.
Proof.
  intros.
  pose proof excluded_middle P.
  destruct H0.
  - left. auto.
  - right. apply (H H0).
Qed.

Ltac entailer :=
    unfold derives, assn_sub;
    simpl; unfold FOL_valid;
    intros; simpl;
    apply convert_IMPLY;
    intros.

Ltac forward_while_linear :=
    apply (hoare_while_linear TrivialFOL); auto; try omega.

Lemma derives_refl: forall P, P |-- P.
Proof.
  intros.
  unfold derives, assn_sub.
  simpl.
  unfold FOL_valid.
  intros.
  simpl.
  apply excluded_middle.
Qed.

Lemma derives_trans: forall P Q R, P |-- Q -> Q |-- R -> P |-- R.
Proof.
  intros.
  unfold derives, assn_sub in *.
  simpl in *.
  unfold FOL_valid in *.
  intros.
  simpl in *. specialize (H J). specialize (H0 J).
  destruct H.
  - left. tauto.
  - destruct H0.
    + tauto.
    + right. tauto.
Qed.

Module Simple_Loop_Demo.

Definition X : var := 0%nat.

(* Lemma post_loop_body_der : forall (n : logical_var),
  0 <= {[X]} AND {[X]} == n - 1 |-- 0 <= {[X]} AND {[X]} == n - 1.
Proof.
  intros.
  entailer.
  auto.
Qed. *)

Lemma pre_loop_body_der : forall (n : logical_var),
  0 <= {[X]} AND {[(! (X == 0))%imp]} AND {[X]} == n
  |-- (0 <= {[X]} AND {[X]} == n - 1) [X |-> (X - 1)%imp].
Proof.
  entailer.
  omega.
Qed.

Fact simple_loop_correct : forall (n : logical_var),
  |-- {{ 0 <= {[X]} AND {[X]} == n }}
      While !(X == 0) Do
        X ::= X - 1
      EndWhile
      {{ 0 <= {[X]} AND NOT {[! (X == 0)]} }}
      $ BigO (LINEAR *** CONSTANT) n.
Proof.
  intros.
  forward_while_linear.
  - intros.
    simpl in *.
    omega.
  - intros.
    rewrite CONSTANT_spec.
    omega.
  - intros.
    rewrite CONSTANT_spec, CONSTANT_spec.
    omega.
  - apply hoare_loosen with (BigTheta CONSTANT n).
    apply Theta2O. simpl. omega.
    eapply hoare_consequence.
    3:{ apply derives_refl. }
    2:{ apply hoare_asgn_bwd. }
    apply pre_loop_body_der.
Qed.

End Simple_Loop_Demo.

Module Slow_Addition_Demo.

Definition X : var := 0%nat.
Definition Y : var := 1%nat.
Definition Z : var := 2%nat.

Lemma pre_loop_der : forall (m n o : logical_var),
  {[X]} == m AND {[Y]} == n AND 0 <= {[X]} AND {[X]} == {[Z]} AND {[Z]} == o |--
  {[X]} + {[Y]} == m + n AND 0 <= {[X]} AND {[X]} == {[Z]} AND {[Z]} == o.
Proof.
  entailer.
  repeat split; auto; try omega.
Qed.

Lemma post_loop_der : forall m n,
  {[X]} + {[Y]} == m + n AND 0 <= {[X]} AND {[X]} == {[Z]} AND NOT {[!(Z == 0)]}
  |-- {[Y]} == m + n.
Proof.
  entailer.
  omega.
Qed.

Fact slow_addition_correct : forall (m n o : logical_var),
  m <> o -> n <> o ->
  |-- {{ {[X]} == m AND {[Y]} == n AND 0 <= {[X]} AND {[X]} == {[Z]} AND {[Z]} == o }}
      While !(Z == 0) Do
        Y ::= Y + 1;;
        Z ::= Z - 1;;
        X ::= X - 1
      EndWhile
      {{ {[Y]} == m + n }}
      $ BigO LINEAR o.
Proof.
  intros.
  rename H into Hmo.
  rename H0 into Hno.
  eapply hoare_consequence.
  apply pre_loop_der.
  2:{ apply post_loop_der. }
  assert (BigO (LINEAR *** (3 ** CONSTANT)) o =< BigO (3 ** LINEAR) o).
  {
    apply O_id.
    intros.
    rewrite poly_mult_spec, poly_scalar_mult_spec,
      poly_scalar_mult_spec, CONSTANT_spec.
    ring.
  }
  assert (BigO (3 ** LINEAR) o =< BigO (1 ** LINEAR) o).
  {
    eapply O_const; simpl; omega.
  }
  eapply hoare_loosen. apply H0. clear H0.
  eapply hoare_loosen. apply H. clear H.
  forward_while_linear.
  - intros.
    simpl. simpl in H.
    omega.
  - simpl.
    destruct (Nat.eq_dec o m); [congruence |].
    destruct (Nat.eq_dec o n); [congruence | auto].
  - intros.
    rewrite poly_scalar_mult_spec, CONSTANT_spec.
    omega.
  - intros.
    repeat rewrite poly_scalar_mult_spec, CONSTANT_spec.
    omega.
  - eapply hoare_loosen.
    apply Theta2O.
    simpl. omega.
    assert (BigTheta (CONSTANT +++ (CONSTANT +++ CONSTANT)) o =< BigTheta (3 ** CONSTANT) o).
    {
      apply Theta_id.
      intros.
      repeat rewrite poly_add_spec.
      rewrite poly_scalar_mult_spec.
      repeat rewrite CONSTANT_spec.
      ring.
    }
    eapply hoare_loosen.
    apply H. clear H.
    eapply hoare_seq_bigtheta.
    2:{
      eapply hoare_seq_bigtheta.
      2:{ apply hoare_asgn_bwd. }
      apply hoare_asgn_bwd.
    }
    simpl.
    eapply hoare_consequence.
    3:{ apply derives_refl. }
    2:{ apply hoare_asgn_bwd. }
    1:{
      entailer.
      omega.
    }
Qed.

End Slow_Addition_Demo.

Module Min_While_Demo.

Definition A : var := 0%nat.
Definition B : var := 1%nat.
Definition C : var := 2%nat.

Fact min_while_correct: forall (a b : Z) (n : logical_var),
  |-- {{ {[A]} == a AND {[B]} == b AND 0 <= a AND 0 <= b AND n == Z.min a b }}
      C ::= 0;;
      While (! (A == 0) && ! (B == 0)) Do
        A ::= A - 1;;
        B ::= B - 1;;
        C ::= C + 1
      EndWhile
      {{ {[C]} == a AND a <= b OR {[C]} == b AND b < a }}
      $ BigO LINEAR n.
Proof.
  (* TODO: Fill in here *)
  intros.
  eapply hoare_consequence.
  apply derives_refl.
Admitted.

End Min_While_Demo.


(** * Combi.SSRComplement.lattice : A simpler mixin for creating lattices     *)
(******************************************************************************)
(*      Copyright (C) 2021-2021 Florent Hivert <florent.hivert@lri.fr>        *)
(*                                                                            *)
(*  Distributed under the terms of the GNU General Public License (GPL)       *)
(*                                                                            *)
(*    This code is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of          *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       *)
(*    General Public License for more details.                                *)
(*                                                                            *)
(*  The full text of the GPL is available at:                                 *)
(*                                                                            *)
(*                  http://www.gnu.org/licenses/                              *)
(******************************************************************************)
Require Import mathcomp.ssreflect.ssreflect.
From mathcomp Require Import ssrbool ssrfun eqtype choice fintype finset order.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Import Order.Theory.
Local Open Scope order_scope.

(** TODO remove me when released in MathComp *)
Module MeetJoinLeMixin.
Section MeetJoinLeMixin.
Variable (disp : unit) (T : porderType disp).

Record of_ := Build {
  meet : T -> T -> T;
  join : T -> T -> T;
  meetP : forall x y z, (x <= meet y z) = (x <= y) && (x <= z);
  joinP : forall x y z, (join x y <= z) = (x <= z) && (y <= z);
}.

Fact meet_lel (m : of_) x y : meet m x y <= meet m y x.
Proof.
have:= le_refl (meet m x y); rewrite meetP => /andP [mlex mley].
by rewrite (meetP m) mlex mley.
Qed.
Fact meetC (m : of_) : commutative (meet m).
Proof. by move=> x y; apply le_anti; rewrite !meet_lel. Qed.
Fact meet_leL (m : of_) x y : (meet m x y) <= x.
Proof. by have:= le_refl (meet m x y); rewrite (meetP m) => /andP []. Qed.
Fact meet_leR (m : of_) x y : (meet m x y) <= y.
Proof. by have:= le_refl (meet m x y); rewrite (meetP m) => /andP []. Qed.

Fact join_lel (m : of_) x y : join m x y <= join m y x.
Proof.
have:= le_refl (join m y x); rewrite joinP => /andP [ylej xlej].
by rewrite (joinP m) ylej xlej.
Qed.
Fact joinC (m : of_) : commutative (join m).
Proof. by move=> x y; apply le_anti; rewrite !join_lel. Qed.
Fact join_leL (m : of_) x y : x <= (join m x y).
Proof. by have:= le_refl (join m x y); rewrite (joinP m) => /andP []. Qed.
Fact join_leR (m : of_) x y : y <= (join m x y).
Proof. by have:= le_refl (join m x y); rewrite (joinP m) => /andP []. Qed.

Program Definition latticeMixin (m : of_) :=
  @LatticeMixin disp _ (meet m) (join m) (meetC m) (joinC m) _ _ _ _ _.
Next Obligation.
move=> x y z; apply le_anti.
apply/andP; split; rewrite !meetP -?andbA; apply/and3P; split.
- exact: meet_leL.
- exact: (le_trans (meet_leR m _ _) (meet_leL m _ _)).
- exact: (le_trans (meet_leR m _ _) (meet_leR m _ _)).
- exact: (le_trans (meet_leL m _ _) (meet_leL m _ _)).
- exact: (le_trans (meet_leL m _ _) (meet_leR m _ _)).
- exact: meet_leR.
Qed.
Next Obligation.
move=> x y z; apply le_anti.
apply/andP; split; rewrite !joinP -?andbA; apply/and3P; split.
- exact: (le_trans (join_leL m _ _) (join_leL m _ _)).
- exact: (le_trans (join_leR m _ _) (join_leL m _ _)).
- exact: join_leR.
- exact: join_leL.
- exact: (le_trans (join_leL m _ _) (join_leR m _ _)).
- exact: (le_trans (join_leR m _ _) (join_leR m _ _)).
Qed.
Next Obligation.
apply le_anti.
apply/andP; split; first exact: meet_leL.
by rewrite meetP le_refl join_leL.
Qed.
Next Obligation.
apply le_anti.
apply/andP; split; last exact: join_leL.
by rewrite joinP le_refl meet_leL.
Qed.
Next Obligation. by rewrite eq_le meetP meet_leL le_refl. Qed.

End MeetJoinLeMixin.

Module Exports.
Coercion latticeMixin : of_ >-> Order.LatticeMixin.of_.
Notation meetJoinLeMixin := of_.
Notation MeetJoinLeMixin := Build.
End Exports.

End MeetJoinLeMixin.
Export MeetJoinLeMixin.Exports.

(** * Onder structure on [{set T}] *)
Module SetSubsetOrder.
Section SetSubsetOrder.

Definition type (disp : unit) (T : finType) := {set T}.
Context {disp : unit} {T : finType}.
Local Notation "'set" := (type disp T) (at level 0) : type_scope.
Implicit Type (A B C : 'set).

Lemma le_def A B : A \subset B = (A :&: B == A).
Proof. exact/setIidPl/eqP. Qed.

Lemma setKUC B A : A :&: (A :|: B) = A.
Proof. by rewrite setUC setKU. Qed.

Lemma setKIC B A : A :|: (A :&: B) = A.
Proof. by rewrite setIC setKI. Qed.

Definition t_distrLatticeMixin :=
  MeetJoinMixin le_def (fun _ _ => erefl _) (@setIC _) (@setUC _)
                (@setIA _) (@setUA _) setKUC setKIC (@setIUl _) (@setIid _).

Lemma subset_display : unit. Proof. exact: tt. Qed.

Canonical eqType := [eqType of 'set].
Canonical choiceType := [choiceType of 'set].
Canonical countType := [countType of 'set].
Canonical finType := [finType of 'set].
Canonical porderType := POrderType subset_display 'set t_distrLatticeMixin.
Canonical latticeType := LatticeType 'set t_distrLatticeMixin.
Canonical bLatticeType := BLatticeType 'set
  (BottomMixin (@sub0set _ : forall A, (set0 <= A :> 'set)%O)).
Canonical tbLatticeType := TBLatticeType 'set
  (TopMixin (@subsetT _ : forall A, (A <= setT :> 'set)%O)).
Canonical distrLatticeType := DistrLatticeType 'set t_distrLatticeMixin.
Canonical bDistrLatticeType := [bDistrLatticeType of 'set].
Canonical tbDistrLatticeType := [tbDistrLatticeType of 'set].

Lemma setIDv A B : B :&: (A :\: B) = set0.
Proof.
apply/eqP; rewrite -subset0; apply/subsetP => x.
by rewrite !inE => /and3P[->].
Qed.

Definition t_cbdistrLatticeMixin := CBDistrLatticeMixin setIDv (@setID _).
Canonical cbDistrLatticeType := CBDistrLatticeType 'set t_cbdistrLatticeMixin.

Lemma setTDsym A : ~: A = setT :\: A.
Proof. by rewrite setTD. Qed.

Definition t_ctbdistrLatticeMixin := CTBDistrLatticeMixin setTDsym.
Canonical ctbDistrLatticeType := CTBDistrLatticeType 'set t_ctbdistrLatticeMixin.

Canonical finPOrderType := [finPOrderType of 'set].
Canonical finLatticeType := [finLatticeType of 'set].
Canonical finDistrLatticeType := [finDistrLatticeType of 'set].
Canonical finCDistrLatticeType := [finCDistrLatticeType of 'set].

Lemma leEset A B : (A <= B) = (A \subset B).
Proof. by []. Qed.
Lemma meetEset A B : A `&` B = A :&: B.
Proof. by []. Qed.
Lemma joinEset A B : A `|` B = A :|: B.
Proof. by []. Qed.
Lemma botEset : 0 = set0 :> 'set.
Proof. by []. Qed.
Lemma topEset : 1 = setT :> 'set.
Proof. by []. Qed.
Lemma subEset A B : A `\` B = A :\: B.
Proof. by []. Qed.
Lemma complEset A : ~` A = ~: A.
Proof. by []. Qed.

End SetSubsetOrder.

Module Exports.

Notation "{set[ d ]<= T }" := (type d T)
  (at level 70, d at next level, format "{set[ d ]<=  T }") : type_scope.
Notation "{set<= T }" := (type subset_display T)
  (at level 70, format "{set<=  T }") : type_scope.

Set Warnings "-redundant-canonical-projection".
Canonical eqType.
Canonical choiceType.
Canonical countType.
Canonical finType.
Canonical porderType.
Canonical latticeType.
Canonical bLatticeType.
Canonical tbLatticeType.
Canonical distrLatticeType.
Canonical bDistrLatticeType.
Canonical tbDistrLatticeType.
Canonical cbDistrLatticeType.
Canonical ctbDistrLatticeType.
Canonical finPOrderType.
Canonical finLatticeType.
Canonical finDistrLatticeType.
Canonical finCDistrLatticeType.
Set Warnings "+redundant-canonical-projection".

Definition leEset := @leEset.
Definition meetEset := @meetEset.
Definition joinEset := @joinEset.
Definition botEset := @botEset.
Definition topEset := @topEset.
Definition subEset := @subEset.
Definition complEset := @complEset.

End Exports.
End SetSubsetOrder.
Export SetSubsetOrder.Exports.

Section BLattice.

Variables (disp : unit) (T : porderType disp).
Variables (disp' : unit) (T' : bLatticeType disp') (f : T -> T').

Variables (f' : T' -> T) (f_can : cancel f f') (f'_can : cancel f' f).
Variable (f_mono : {mono f : x y / x <= y}).

Lemma le0x x : f' 0 <= x.
Proof. by rewrite -f_mono f'_can le0x. Qed.

Definition IsoBottomMixin :=
  @BottomMixin _ (LatticeType T (Order.CanMixin.IsoLattice f_can f'_can f_mono))
               _ le0x.

End BLattice.

Section TBLattice.

Variables (disp : unit) (T : bLatticeType disp).
Variables (disp' : unit) (T' : tbLatticeType disp') (f : T -> T').

Variables (f' : T' -> T) (f_can : cancel f f') (f'_can : cancel f' f).
Variable (f_mono : {mono f : x y / x <= y}).

Lemma lex1 x : x <= f' 1.
Proof. by rewrite -f_mono f'_can lex1. Qed.

Definition IsoTopMixin :=
  @TopMixin _ (BLatticeType T (IsoBottomMixin f_can f'_can f_mono))
            _ lex1.

End TBLattice.


(* Doubly-negated types as a monad: *)

Definition DN (T: Type): Prop := (T -> False) -> False.

Hint Unfold DN.

Definition DN_return {T: Type}: T -> DN T :=
  fun x f => f x.

Notation "'return' x" := (DN_return x) (at level 30).

Hint Resolve @DN_return.

Definition DN_bind {A: Type}: DN A -> forall B, (A -> DN B) -> DN B :=
  fun X Y Z P => X (fun a => Z a P).

Notation "x <- e ; t" := (DN_bind e _ (fun x => t)) (right associativity, at level 60).

Definition ext_eq: Prop := forall (A B: Type) (f g: A -> B), (forall x, f x = g x) -> f = g.

Lemma DN_runit: ext_eq -> forall A (x: DN A),
  DN_bind x _ DN_return = x.
Proof.
  intros.
  cut (forall y y', y = y' -> x y = x y'). firstorder.
  congruence.
Qed.

Lemma DN_lunit: ext_eq -> forall A B (a: A) (f: A -> DN B),
  DN_bind (DN_return a) _ f = f a.
Proof. firstorder. Qed.

Lemma DN_assoc A B C (a: DN A) (f: A -> DN B) (g: B -> DN C):
  DN_bind (DN_bind a _ f) _ g = DN_bind a _ (fun x => DN_bind (f x) _ g).
Proof. reflexivity. Qed.

Lemma DN_fmap {A: Type}: DN A -> forall B, (A -> B) -> DN B.
Proof. firstorder. Qed.

Lemma DN_liftM2 {A B C: Type} (f: A -> B -> C): DN A -> DN B -> DN C.
Proof. firstorder. Qed.
  (* todo: this is a specialization for DN. make a normal monadic version *)

Lemma DN_exists {T: Type} {P: T -> Prop} {x: T}: DN (P x) -> DN (ex P).
Proof. firstorder. Qed.

Inductive Stable P := mkStable: (DN P -> P) -> Stable P.
  (* Using an Inductive gets us universe polymorphism, which the following
   simpler alternative does not provide: *)

(* Definition Stable P := DN P -> P. *)

Lemma DN_apply {T: Type}: DN T -> forall P, Stable P -> (T -> P) -> P.
Proof. firstorder. Qed.

Lemma DN_free P: Stable P -> DN P -> P.
Proof. firstorder. Qed.

Lemma Stable_neg (P: Prop): Stable (~P).
Proof. firstorder. Qed.

Lemma Stable_False: Stable False.
Proof. firstorder. Qed.

Lemma Stable_True: Stable True.
Proof. firstorder. Qed.

Hint Immediate Stable_False Stable_True.

Lemma stable_conjunction (A B: Prop): Stable A -> Stable B -> Stable (A /\ B).
Proof. firstorder. Qed.

Hint Resolve stable_conjunction.

Lemma forall_stable (T: Type) (P: T -> Type): (forall x, Stable (P x)) -> Stable (forall x, P x).
Proof. firstorder. Qed.

Hint Resolve forall_stable.

Require Import util.

Lemma decision_stable P: decision P -> Stable P.
Proof. firstorder. Qed.

Require Import CRreal Classic.

Lemma Qle_dec x y: decision (Qle x y).
  intros.
  destruct (Qlt_le_dec y x); [right | left]; [apply Qlt_not_le |]; assumption.
Defined.
  (* Todo: Don't I have this elsewhere? *)

(* Everything is decidable in DN: *)

Lemma DN_decision (P: Prop): DN (decision P).
Proof. firstorder. Qed.

Lemma DN_decisionT (P: Type): DN (P + (P->False)).
Proof. firstorder. Qed.

Lemma CRnonNeg_stable x: Stable (CRnonNeg x).
Proof with auto.
  unfold CRnonNeg.
  intros.
  constructor.
  intros.
  destruct (Qle_dec (-e) (approximate x e))...
  elimtype False...
Qed.

Hint Resolve CRnonNeg_stable.

Lemma CRle_stable (x y: CR): Stable (CRle x y).
Proof. unfold CRle. auto. Qed.

Hint Resolve CRle_stable.

Lemma CReq_stable (x y: CR): Stable (x == y)%CR.
Proof.
  unfold st_eq. simpl.
  unfold regFunEq, ball. simpl.
  unfold Qmetric.Qball, AbsSmall.
  auto using decision_stable, Qle_dec.
Qed.

Open Local Scope CR_scope.

Lemma DN_or P Q: Not ((Not P) /\ (Not Q)) -> DN (P + Q).
Proof. firstorder. Qed.

(*
Coercion COr_to_sum A B (x: COr A B): A + B :=
  match x with
  | Cinleft y => inl y
  | Cinright y => inr y
  end.
*)

Definition not_forall_exists_not_DN (T: Type) (P: T -> Prop) (Pd: forall x, P x \/ ~ P x):
  (~ forall x, P x) -> DN (exists x, ~ P x).
Proof. firstorder. Qed.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable wd_ : Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.

Variable col_swap1_1 : (forall A B C : Universe, (col_ A B C -> col_ B A C)).
Variable col_swap2_2 : (forall A B C : Universe, (col_ A B C -> col_ B C A)).
Variable col_triv_3 : (forall A B : Universe, col_ A B B).
Variable wd_swap_4 : (forall A B : Universe, (wd_ A B -> wd_ B A)).
Variable col_trans_5 : (forall P Q A B C : Universe, ((wd_ P Q /\ (col_ P Q A /\ (col_ P Q B /\ col_ P Q C))) -> col_ A B C)).

Theorem pipo_6 : (forall O E Eprime A D U : Universe, ((wd_ U O /\ (wd_ O E /\ (wd_ O Eprime /\ (wd_ E Eprime /\ (wd_ A O /\ (wd_ O O /\ (col_ O E A /\ (col_ O E O /\ (col_ O E O /\ (col_ O E D /\ col_ O E U)))))))))) -> col_ O U D)).
Proof.
  time tac.
Qed.

End FOFProblem.