diff --git a/CaseStudies/Convergence/Algorithm_noB.v b/CaseStudies/Convergence/Algorithm_noB.v
index a5eb6b0a49b97ee068c7e2e64c6f746970e8e05e..48c4ed1bce14c65c481e954e9cf24f8ed308c233 100644
--- a/CaseStudies/Convergence/Algorithm_noB.v
+++ b/CaseStudies/Convergence/Algorithm_noB.v
@@ -24,6 +24,8 @@ Require Import SetoidDec.
Require Import Lia.
Require Import SetoidList.
Require Import Pactole.Util.Preliminary.
+Require Import Pactole.Util.Bijection.
+Require Import Pactole.Util.Fin.
Require Import Pactole.Setting.
Require Import Pactole.Spaces.R2.
Require Import Pactole.Observations.SetObservation.
@@ -39,13 +41,12 @@ Typeclasses eauto := (bfs).
Section ConvergenceAlgo.
-(** There are [n] good robots and no byzantine one. *)
-Variable n : nat.
-Hypothesis n_non_0 : n <> 0%nat.
+(** There are [ub] good robots and no byzantine one. *)
+Context {k : nat} {ltc_0_k : 0 <c k}.
-Instance MyRobots : Names := Robots n 0.
+Instance MyRobots : Names := Robots k 0.
Instance NoByz : NoByzantine.
-Proof using. now split. Qed.
+Proof using . now split. Qed.
(* BUG?: To help finding correct instances, loops otherwise! *)
Instance Loc : Location := {| location := R2 |}.
@@ -89,11 +90,10 @@ Implicit Type pt : location.
(** As there are robots, the observation can never be empty. *)
Lemma obs_non_empty : forall config pt, obs_from_config config pt =/= @empty location _ _ _.
-Proof using n_non_0.
+Proof using ltc_0_k.
intros config pt.
rewrite obs_from_config_ignore_snd. intro Habs.
-assert (Hn : 0%nat < n). { generalize n_non_0. intro. lia. }
-pose (g := exist _ 0%nat Hn : G).
+pose (g := fin0 : G).
specialize (Habs (config (Good g))).
rewrite empty_spec in Habs.
assert (Hin := pos_in_config config origin (Good g)).
@@ -170,7 +170,7 @@ Theorem round_simplify : forall da config, SSYNC_da da ->
== fun id => if da.(activate) id
then isobarycenter (@elements location _ _ _ (!! config))
else config id.
-Proof using n_non_0.
+Proof using ltc_0_k.
intros da config HSSYNC. rewrite SSYNC_round_simplify; trivial; [].
intro id. pattern id. apply no_byz. clear id. intro g.
unfold round. destruct_match; try reflexivity; [].
@@ -196,18 +196,19 @@ Axiom isobarycenter_circle : forall center radius (l : list R2),
Lemma contained_isobarycenter : forall c r config,
contained c r config -> (dist c (isobarycenter (elements (!! config))) <= r)%R.
-Proof using n_non_0.
+Proof using .
intros c r config Hc. apply isobarycenter_circle.
rewrite Forall_forall. intro.
rewrite <- InA_Leibniz. change eq with (@equiv location _).
rewrite elements_spec, obs_from_config_In.
-intros [id Hpt]. rewrite <- Hpt.
+intros [id Hpt]. Fail timeout 10 rewrite <- Hpt. (* FIXME: the rewrite should not fail *)
+apply (@dist_compat location _ _ _ _ _ _ (reflexivity c)) in Hpt. rewrite <- Hpt.
pattern id. apply no_byz. apply Hc.
Qed.
Lemma contained_next : forall da c r config, SSYNC_da da ->
contained c r config -> contained c r (round convergeR2 da config).
-Proof using n_non_0.
+Proof using ltc_0_k.
intros da c r config HSSYNC Hconfig g.
rewrite round_simplify; trivial; [].
destruct_match.
@@ -217,7 +218,7 @@ Qed.
Lemma converge_forever : forall d c r config, SSYNC d ->
contained c r config -> imprisoned c r (execute convergeR2 d config).
-Proof using n_non_0.
+Proof using ltc_0_k.
cofix Hcorec. intros d c r config [] Hrec. constructor.
- apply Hrec.
- apply Hcorec; auto using contained_next.
@@ -229,14 +230,14 @@ Qed.
(************************)
Theorem convergence_FSYNC : solution_FSYNC convergeR2.
-Proof using n_non_0.
+Proof using ltc_0_k.
intros config d [Hfair ?].
exists (isobarycenter (elements (obs_from_config (Observation := set_observation) config 0))).
intros ε Hε.
apply Stream.Later, Stream.Now. rewrite execute_tail.
apply converge_forever; auto using FSYNC_SSYNC; [].
intro g. rewrite round_simplify; auto using FSYNC_SSYNC_da; [].
-rewrite Hfair. changeR2.
+hnf in Hfair. rewrite Hfair. changeR2.
transitivity 0%R; try (now apply Rlt_le); [].
apply Req_le. now apply dist_defined.
Qed.
diff --git a/CaseStudies/Convergence/Impossibility_2G_1B.v b/CaseStudies/Convergence/Impossibility_2G_1B.v
index afb413f19336e54757f1ed5ffc7260a6beb57945..1c57cf28dfba680daff179ea0f204534b07a26c0 100644
--- a/CaseStudies/Convergence/Impossibility_2G_1B.v
+++ b/CaseStudies/Convergence/Impossibility_2G_1B.v
@@ -22,10 +22,12 @@ Require Import Utf8.
Require Import Reals.
Require Import Psatz.
Require Import SetoidDec.
-Require Import Arith.Div2.
Require Import Lia.
Require Import SetoidList.
Require Import Pactole.Util.Preliminary.
+Require Import Pactole.Util.Bijection.
+Require Import Pactole.Util.Fin.
+Require Import Pactole.Util.Enum.
Require Import Pactole.Setting.
Require Import Pactole.Spaces.R.
Require Import Pactole.Observations.MultisetObservation.
@@ -38,9 +40,8 @@ Import Datatypes.
Import List.
Import SetoidClass.
-
-Typeclasses eauto := (bfs).
-
+(* this will become non default soon. *)
+Ltac Tauto.intuition_solver ::= auto with *.
Section ConvergenceImpossibility.
(** There are [2 * n] good robots and [n] byzantine ones. *)
@@ -132,7 +133,7 @@ Proof using n_non_0.
assert (Hn0 := n_non_0). rewrite nG_nB, nB_value.
destruct n as [| ?].
- lia.
-- simpl. rewrite plus_comm. simpl. lia.
+- cbn. rewrite Nat.add_comm. cbn. auto with arith.
Qed.
(* TODO: move to a definition/problem file *)
@@ -186,7 +187,6 @@ Lemma synchro : ∀ r, solution r → solution_FSYNC r.
Proof using . unfold solution. intros r Hfair config d Hd. apply Hfair, FSYNC_implies_Fair; autoclass. Qed.
Close Scope R_scope.
-Close Scope vector_scope.
(** We split good robots into two halves. *)
@@ -214,18 +214,17 @@ eapply firstn_skipn_nodup_exclusive; try eassumption.
apply Gnames_NoDup.
Qed.
-Lemma left_spec : forall g, In g left <-> proj1_sig g < Nat.div2 nG.
+Lemma left_spec : forall g, In g left <-> fin2nat g < Nat.div2 nG.
Proof using .
Local Transparent G.
-intro g. unfold left, half1. rewrite Gnames_length. unfold Gnames.
-apply firstn_enum_spec.
+intro g. unfold left, half1. rewrite Gnames_length. apply firstn_enum_spec.
Local Opaque G.
Qed.
-Lemma right_spec : forall g, In g right <-> Nat.div2 nG <= proj1_sig g.
+Lemma right_spec : forall g, In g right <-> Nat.div2 nG <= fin2nat g.
Proof using .
intro g. unfold right, half2. rewrite Gnames_length. unfold Gnames.
-rewrite (skipn_enum_spec (Nat.div2 nG) g). intuition. apply proj2_sig.
+rewrite (skipn_enum_spec (Nat.div2 nG) g). intuition. apply fin_lt.
Qed.
(** First and last robots are resp. in the first and in the second half. *)
@@ -242,7 +241,7 @@ Lemma glast_right : In glast right.
Proof using .
rewrite right_spec. simpl. assert (Heven := even_nG).
destruct n as [| [| ]]; simpl; auto; [].
-apply le_n_S, Nat.div2_decr, le_n_Sn.
+apply le_n_S, Nat.div2_decr, Nat.le_succ_diag_r.
Qed.
Hint Resolve gfirst_left glast_right left_right_exclusive : core.
@@ -256,7 +255,6 @@ Hint Resolve gfirst_left glast_right left_right_exclusive : core.
- the stack with byzantine is activated, good robots cannot move. *)
Open Scope R_scope.
-Open Scope vector_scope.
(** The reference starting configuration **)
Definition config1 : configuration := fun id =>
@@ -308,7 +306,7 @@ intros pt1 pt2 Hdiff pt k. induction k as [| k]; intros l Hnodup Hlen.
cbn [map]. rewrite map_app. cbn [map].
destruct (in_dec Geq_dec a (a :: half1 l)) as [_ | Habs].
destruct (in_dec Geq_dec z (a :: half1 l)) as [Habs | _].
- + inversion_clear Habs; try (now elim Haz); [].
+ + inversion_clear Habs; try (now contradiction Haz); [].
exfalso. now apply Hzl, half1_incl.
+ rewrite (map_ext_in _ (fun x => if in_dec Geq_dec x (half1 l) then pt1 else pt2)).
- cbn [countA_occ]. rewrite countA_occ_app. rewrite IHk; trivial.
@@ -320,9 +318,9 @@ intros pt1 pt2 Hdiff pt k. induction k as [| k]; intros l Hnodup Hlen.
- intros x Hin.
destruct (in_dec Geq_dec x (half1 l)) as [Hx | Hx],
(in_dec Geq_dec x (a :: half1 l)) as [Hx' | Hx']; trivial.
- -- elim Hx'. intuition.
+ -- contradiction Hx'. intuition.
-- inversion_clear Hx'; subst; contradiction.
- + elim Habs. intuition.
+ + contradiction Habs. intuition.
Qed.
Theorem obs_config1 : !! config1 == observation1.
@@ -380,8 +378,7 @@ intro pt. unfold observation1, observation2, swap. rewrite map_add, map_singleto
cbn -[add singleton].
ring_simplify (1 + -1 * (0 + -(1)) + -(1)).
ring_simplify (1 + -1 * (1 + -(1)) + -(1)).
-destruct (Rdec pt 0); [| destruct (Rdec pt 1)]; subst;
-repeat rewrite ?add_same, ?singleton_same, ?singleton_other, ?add_other; auto.
+now rewrite <- add_singleton_comm.
Qed.
(** An execution alternating config1 and config2 *)
@@ -609,7 +606,7 @@ induction Hpt as [e IHpt | e IHpt]; intros start Hstart.
clear -absurdmove Hnow1 Hnow2 n_non_0. specialize (Hnow1 gfirst). specialize (Hnow2 gfirst).
cut (Rabs move <= Rabs (move / 3) + Rabs (move / 3)).
- assert (Hpos : 0 < Rabs move) by now apply Rabs_pos_lt.
- unfold Rdiv. rewrite Rabs_mult, Rabs_Rinv; try lra.
+ unfold Rdiv. rewrite Rabs_mult, Rabs_inv; try lra.
assert (Habs3 : Rabs 3 = 3). { apply Rabs_pos_eq. lra. } rewrite Habs3 in *.
lra.
- simpl in *. rewrite sqrt_square in Hnow1, Hnow2.
diff --git a/CaseStudies/Exploration/Definitions.v b/CaseStudies/Exploration/Definitions.v
deleted file mode 100644
index 8ef725984c98ea2dc09eb9601da21aca978d96cc..0000000000000000000000000000000000000000
--- a/CaseStudies/Exploration/Definitions.v
+++ /dev/null
@@ -1,193 +0,0 @@
-(**************************************************************************)
-(* Mechanised Framework for Local Interactions & Distributed Algorithms *)
-(* C. Auger, P. Courtieu, L. Rieg, X. Urbain , R. Pelle *)
-(* PACTOLE project *)
-(* *)
-(* This file is distributed under the terms of the CeCILL-C licence *)
-(* *)
-(**************************************************************************)
-
-
-Require Import Reals Lia Arith.Div2 Psatz SetoidDec.
-Require Export Pactole.Setting.
-Require Export Pactole.Spaces.Ring.
-Require Export Pactole.Spaces.Isomorphism.
-Require Export Pactole.Observations.MultisetObservation.
-
-
-Close Scope Z_scope.
-Set Implicit Arguments.
-Typeclasses eauto := (bfs).
-
-
-Section ExplorationDefs.
-
-(** Setting definitions *)
-
-
-(** Definition of the ring. *)
-Context {RR : RingSpec}.
-(* We do not care about threshold values, so we just take 1/2 everywhere. *)
-Existing Instance localRing.
-Notation ring_node := (finite_node ring_size).
-(* NB: These instances will be replaced by the glob_* ones so they are local. *)
-
-(* begin show *)
-(** Number of good and Byzantine robots *)
-Context {Robots : Names}.
-
-(** Robots are on nodes *)
-Global Instance Loc : Location := make_Location ring_node.
-
-(** States of robots only contains their location. *)
-Global Instance St : State location := OnlyLocation (fun _ => True).
-Global Existing Instance proj_graph.
-
-(** Robots observe the location of others robots with strong multiplicity. *)
-Global Existing Instance multiset_observation.
-
-(** Robots only decide in which direction they want to move. *)
-Global Instance RC : robot_choice direction := { robot_choice_Setoid := direction_Setoid }.
-
-(** Demon's frame choice: we move back the robot to the origin with a translation
- and we can choose the orientation of the ring. *)
-Global Instance FC : frame_choice (Z * bool) := {
- frame_choice_bijection :=
- fun nb => if snd nb then Ring.sym (fst nb) else Ring.trans (fst nb);
- frame_choice_Setoid := eq_setoid _ }.
-
-Global Existing Instance NoChoice.
-Global Existing Instance NoChoiceIna.
-Global Existing Instance NoChoiceInaFun.
-
-Global Instance UpdFun : update_function direction (Z * bool) unit := {
- update := fun config g _ dir _ => move_along (config (Good g)) dir;
- update_compat := ltac:(repeat intro; subst; now apply move_along_compat) }.
-(* end show *)
-
-(* Global Instance setting : GlobalDefinitions := {
- (* Number of good and Byzantine robots *)
- glob_Names := Robots;
- (* The space in which robots evolve *)
- glob_Loc := Loc;
- (* The state of robots (must contain at least the current location) *)
- glob_info := location;
- glob_State := OnlyLocation (fun _ => True);
- (* The observation: what robots can see from their surroundings *)
- glob_obs := multiset_observation;
- (* The output type of robograms: some information that we can use to get a target location *)
- glob_Trobot := direction;
- glob_robot_choice := RC;
- (* The frame decision made by the demon, used to build the frame change *)
- glob_Tframe := Z * bool;
- glob_frame_choice := FC;
- (* The influence of the demon on the state update of robots, when active *)
- glob_Tactive := unit;
- glob_update_choice := NoChoice;
- (* The influence of the demon on the state update of robots, when inactive *)
- glob_Tinactive := unit;
- glob_inactive_choice := NoChoiceIna;
- (* How a robots state is updated:
- - if active, using the result of the robogram and the decision from the demon
- - if inactive, using only the decision from the demon *)
- glob_update_function := UpdFun;
- glob_inactive_function := NoChoiceInaFun }. *)
-
-(** ** Specification of exploration with stop *)
-
-(** Any node will eventually be visited. *)
-Definition is_visited (pt : location) (config : configuration) :=
- exists g, config (Good g) == pt.
-
-Definition Will_be_visited (pt : location) (e : execution) :=
- Stream.eventually (Stream.instant (is_visited pt)) e.
-
-Definition simple_exploration (e : execution) :=
- forall pt, Will_be_visited pt e.
-
-Definition perpetual_exploration (e : execution) :=
- Stream.forever simple_exploration e.
-
-(** Eventually, all robots stop moving. *)
-Definition Stall (e : execution) := Stream.hd e == (Stream.hd (Stream.tl e)).
-
-Definition Stopped (e : execution) : Prop :=
- Stream.forever Stall e.
-
-Definition Will_stop (e : execution) : Prop :=
- Stream.eventually Stopped e.
-
-(** [Exploration_with_stop e] means that execution [e] indeed solves exploration with stop:
- after a finite time, every node of the space has been visited and all robots will stay
- at the same place forever. *)
-Definition ExplorationWithStop (e : execution) :=
- simple_exploration e /\ Will_stop e.
-
-(** [FullSolExplorationWithStop r d] means that the robogram [r] solves exploration with stop
- agains demon [d] regardless of the starting configuration.
-
- This is actually impossible when the number of robots is less than the size of the ring. *)
-Definition FullSolExplorationWithStop (r : robogram) (d : demon) :=
- forall config, ExplorationWithStop (execute r d config).
-
-(** Acceptable starting configurations contain no tower,
- that is, all robots are at different locations. *)
-Definition Valid_starting_config config : Prop :=
- Util.Preliminary.injective (@Logic.eq ident) (@equiv _ state_Setoid) config.
-(* forall pt : location, ((obs_from_config config (of_Z 0))[pt] <= 1)%nat. *)
-
-Definition Explore_and_Stop (r : robogram) :=
- forall d config, Fair d -> Valid_starting_config config ->
- ExplorationWithStop (execute r d config).
-
-(** Compatibility properties *)
-Global Instance is_visited_compat : Proper (equiv ==> equiv ==> iff) is_visited.
-Proof using .
-intros pt1 pt2 Hpt config1 config2 Hconfig.
-split; intros [g Hv]; exists g.
-- now rewrite <- Hconfig, Hv, Hpt.
-- now rewrite Hconfig, Hv, Hpt.
-Qed.
-
-Global Instance Will_be_visited_compat : Proper (equiv ==> equiv ==> iff) Will_be_visited.
-Proof using .
-intros ? ? ?. now apply Stream.eventually_compat, Stream.instant_compat, is_visited_compat.
-Qed.
-
-Global Instance simple_exploration_compat : Proper (equiv ==> iff) simple_exploration.
-Proof using . intros e1 e2 He. unfold simple_exploration. now setoid_rewrite He. Qed.
-
-Global Instance perpetual_exploration_compat : Proper (equiv ==> iff) perpetual_exploration.
-Proof using . apply Stream.forever_compat, simple_exploration_compat. Qed.
-
-Global Instance Stall_compat : Proper (equiv ==> iff) Stall.
-Proof using .
-intros e1 e2 He. split; intros Hs; unfold Stall in *;
-(now rewrite <- He) || now rewrite He.
-Qed.
-
-Global Instance Stopped_compat : Proper (equiv ==> iff) Stopped.
-Proof using .
-intros e1 e2 He. split; revert e1 e2 He; coinduction rec.
-- destruct H. now rewrite <- He.
-- destruct H as [_ H], He as [_ He]. apply (rec _ _ He H).
-- destruct H. now rewrite He.
-- destruct H as [_ H], He as [_ He]. apply (rec _ _ He H).
-Qed.
-
-Global Instance Will_stop_compat : Proper (equiv ==> iff) Will_stop.
-Proof using . apply Stream.eventually_compat, Stopped_compat. Qed.
-
-Global Instance Valid_starting_config_compat : Proper (equiv ==> iff) Valid_starting_config.
-Proof using .
-intros ? ? Hconfig.
-unfold Valid_starting_config, Util.Preliminary.injective.
-now setoid_rewrite Hconfig.
-Qed.
-
-(** We can decide if a given configuration is a valid starting one. *)
-Lemma Valid_starting_config_dec : forall config,
- {Valid_starting_config config} + {~ Valid_starting_config config}.
-Proof using . intro config. unfold Valid_starting_config. apply config_injective_dec. Qed.
-
-End ExplorationDefs.
diff --git a/CaseStudies/Exploration/ExplorationDefs.v b/CaseStudies/Exploration/ExplorationDefs.v
new file mode 100644
index 0000000000000000000000000000000000000000..0229171cbc4ad13e37329da963cecaf786eb99cf
--- /dev/null
+++ b/CaseStudies/Exploration/ExplorationDefs.v
@@ -0,0 +1,104 @@
+Require Export Pactole.Setting.
+Require Import Pactole.Util.Stream.
+
+Set Implicit Arguments.
+
+Section ExplorationDefs.
+
+Context {Robots : Names} {Loc : Location}.
+Context {Tframe Trobot Tinfo Tactive Tinactive: Type}.
+Context {RC : robot_choice Trobot} {FC : frame_choice Tframe}.
+Context {UC : update_choice Tactive} {IC : inactive_choice Tinactive}.
+Context {St : State Tinfo} {Obs : Observation}.
+Context {UpdFun : update_function Trobot Tframe Tactive}.
+Context {InaFun : inactive_function Tinactive}.
+
+(** ** Specification of exploration with stop *)
+
+Definition is_visited (l : location) (c : configuration) : Prop :=
+ exists g, get_location (c (Good g)) == l.
+
+(** Any node will eventually be visited. *)
+Definition Will_be_visited (l : location) (e : execution) : Prop :=
+ eventually (instant (is_visited l)) e.
+
+Definition simple_exploration (e : execution) :=
+ forall pt, Will_be_visited pt e.
+
+Definition perpetual_exploration (e : execution) :=
+ Stream.forever simple_exploration e.
+
+(** Eventually, all robots stop moving. *)
+Definition Stall (e : execution) := hd e == (hd (tl e)).
+
+Definition Stopped (e : execution) : Prop :=
+ forever Stall e.
+
+Definition Will_stop (e : execution) : Prop :=
+ eventually Stopped e.
+
+(** [ExplorationStop e] means that after a finite time, every node of the space has been
+ visited, and after that time, all robots will stay at the same place forever. *)
+Definition ExplorationStop (e : execution) :=
+ simple_exploration e /\ Will_stop e.
+
+Global Instance is_visited_compat :
+ Proper (equiv ==> equiv ==> iff) is_visited.
+Proof using .
+ intros l1 l2 Hl c1 c2 Hc. unfold is_visited. split; intros [g H].
+ - exists g. rewrite <- Hl, <- Hc. exact H.
+ - exists g. rewrite Hl, Hc. exact H.
+Qed.
+
+Global Instance Will_be_visited_compat :
+ Proper (equiv ==> equiv ==> iff) Will_be_visited.
+Proof using .
+ intros l1 l2 Hl e1 e2 He. unfold Will_be_visited. split; intros H.
+ - rewrite <- He, <- Hl. exact H.
+ - rewrite He, Hl. exact H.
+Qed.
+
+Global Instance simple_exploration_compat :
+ Proper (equiv ==> iff) simple_exploration.
+Proof using .
+ intros e1 e2 He. unfold simple_exploration. now setoid_rewrite He.
+Qed.
+
+Global Instance perpetual_exploration_compat :
+ Proper (equiv ==> iff) perpetual_exploration.
+Proof using . apply Stream.forever_compat, simple_exploration_compat. Qed.
+
+Global Instance Stall_compat : Proper (equiv ==> iff) Stall.
+Proof using .
+ intros e1 e2 He. unfold Stall. split; intros H.
+ - rewrite <- He. exact H.
+ - rewrite He. exact H.
+Qed.
+
+Global Instance Stopped_compat : Proper (equiv ==> iff) Stopped.
+Proof using .
+ intros e1 e2 He. unfold Stopped. split; intros H.
+ - rewrite <- He. exact H.
+ - rewrite He. exact H.
+Qed.
+
+Global Instance Will_stop_compat : Proper (equiv ==> iff) Will_stop.
+Proof using .
+ intros e1 e2 He. unfold Will_stop. split; intros H.
+ - rewrite <- He. exact H.
+ - rewrite He. exact H.
+Qed.
+
+Global Instance ExplorationStop_compat :
+ Proper (equiv ==> iff) ExplorationStop.
+Proof using .
+ intros e1 e2 He. unfold ExplorationStop. split; intros [Hx Hs].
+ - split.
+ + intros l. rewrite <- He. exact (Hx l).
+ + rewrite <- He. exact Hs.
+ - split.
+ + intros l. rewrite He. exact (Hx l).
+ + rewrite He. exact Hs.
+Qed.
+
+End ExplorationDefs.
diff --git a/CaseStudies/Exploration/ImpossibilityKDividesN.v b/CaseStudies/Exploration/ImpossibilityKDividesN.v
index cbdc3fba587400a851c8774886c6fbcb315fce22..0a0269cf42aa284c7d33c79b6444cc8a337a27d7 100644
--- a/CaseStudies/Exploration/ImpossibilityKDividesN.v
+++ b/CaseStudies/Exploration/ImpossibilityKDividesN.v
@@ -7,50 +7,67 @@
(* *)
(**************************************************************************)
-
-Require Import Psatz Rbase.
-Require Import Morphisms.
-Require Import Arith.Div2.
-Require Import Lia.
-Require Import Decidable.
-Require Import Equalities.
-Require Import List Setoid SetoidList Compare_dec Morphisms.
+Require Import Utf8.
+Require Import Arith Lia.
+Require Import SetoidList.
+Require Import Pactole.Util.Stream.
Require Import Pactole.Models.NoByzantine.
-Require Import Pactole.CaseStudies.Exploration.Definitions.
-
+Require Import Pactole.Models.RingSSync.
+Require Import Pactole.CaseStudies.Exploration.ExplorationDefs.
-Open Scope Z_scope.
Set Implicit Arguments.
-Typeclasses eauto := (bfs).
-
Section Exploration.
(** Given an abitrary ring *)
-Context {RR : RingSpec}.
-(** There are kG good robots and no byzantine ones. *)
-Variable kG : nat.
-Instance Robots : Names := Robots kG 0.
+Context {n : nat} {ltc_2_n : 2 <c n}.
+(** There are k good robots and no byzantine ones. *)
+Context {k : nat} {ltc_0_k : 0 <c k}.
+Instance Robots : Names := Robots k 0.
+
+(** Assumptions on the number of robots: it strictly divides the ring size. *)
+Hypothesis kdn : (n mod k = 0).
+Hypothesis k_inf_n : (k < n).
+
+Lemma h_not_0: n <> 0.
+Proof using ltc_2_n.
+ unfold ltc in *.
+ apply neq_lt.
+ transitivity 2; auto with arith.
+Qed.
+
+Lemma k_not_0: k <> 0.
+Proof using ltc_0_k.
+ unfold ltc in *.
+ now apply neq_lt.
+Qed.
+
+Local Hint Resolve h_not_0 k_not_0: localDB.
-(** Assumptions on the number of robots: it is non zero, less than and divides the ring size. *)
-Hypothesis kdn : (ring_size mod kG = 0)%nat.
-(* (* FIXME: This version triggers an "out of memory" error in the Program Definition of [da]! *)
-Hypothesis k_bounds : (1 < kG < ring_size)%nat.
-Definition k_sup_1 : (1 < kG)%nat := proj1 k_bounds.
-Definition k_inf_n : (kG < ring_size)%nat := proj2 k_bounds. *)
-Hypothesis k_sup_1 : (1 < kG)%nat.
-Hypothesis k_inf_n : (kG < ring_size)%nat.
+Lemma local_subproof1 : n = k * (n / k).
+Proof using kdn ltc_0_k. apply Nat.Div0.div_exact. auto with localDB. Qed.
+
+Lemma local_subproof2 : n / k ≠0.
+Proof using kdn ltc_2_n ltc_0_k.
+ intros Habs. eapply @neq_u_0. apply ltc_2_n. rewrite local_subproof1, Habs. clear. lia.
+Qed.
+Local Hint Resolve local_subproof1 local_subproof2 : localDB.
+
+Lemma local_subproof3 : ∀ m : nat, m < k -> m * (n / k) < n.
+Proof using kdn k_inf_n ltc_0_k.
+intros * H. pattern n at 2. rewrite (Nat.div_mod_eq n k). (* FIXME: bug in rewrite? *)
+rewrite kdn, Nat.add_0_r, <- Nat.mul_lt_mono_pos_r; trivial; [].
+apply Nat.div_str_pos. split; auto with arith.
+Qed.
Instance NoByz : NoByzantine.
Proof using . now split. Qed.
(** A dummy state used for (inexistant) byzantine robots. *)
-Definition origin : location := of_Z 0.
-Definition dummy_loc : location := origin. (* could be anything *)
-
-Notation "!! config" := (obs_from_config config origin) (at level 0).
+Definition dummy_loc : location := fin0. (* could be anything *)
+Notation "!! config" := (obs_from_config config dummy_loc) (at level 0).
(** Let us consider an arbirary robogram. *)
Variable r : robogram.
@@ -58,13 +75,13 @@ Variable r : robogram.
(** The key idea is to prove that we can always make robots think that there are
in the same configuration. Thus, is they move at all, then they will never stop.
If they do not move, they do not explore the ring.
- The configuration to which we will always come back is [ref_config],
+ The configuration to which we will always come back is [NoByz_periodic_config],
in which robots are evenly spaced on the ring. *)
-(** *** Definition of the reference configuration and demon used in the proof **)
+(** *** Definition of the demon used in the proof **)
Definition create_ref_config (g : G) : location :=
- Ring.of_Z (Z_of_nat (proj1_sig g * (ring_size / kG))).
+ mod2fin (fin2nat g * (n / k)).
(** The starting configuration where robots are evenly spaced:
each robot is at a distance of [ring_size / kG] from the previous one,
@@ -75,109 +92,75 @@ Definition ref_config : configuration :=
| Byz b => dummy_loc
end.
+
Lemma ref_config_injective :
Util.Preliminary.injective eq equiv (fun id => get_location (ref_config id)).
-Proof using k_sup_1 k_inf_n kdn.
-intros id1 id2.
-assert (ring_size / kG <> 0)%nat by (rewrite Nat.div_small_iff; lia).
-apply (no_byz id2), (no_byz id1). clear id1 id2.
-intros g1 g2 Heq. f_equal. hnf in Heq.
-unfold ref_config, create_ref_config, Ring.of_Z in *. simpl in *.
-apply (f_equal to_Z) in Heq. unfold to_Z in Heq. simpl in Heq.
-rewrite 2 Z2Nat.id in Heq; try (apply Z.mod_pos_bound; lia); [].
-assert (Hlt : forall n, (n < kG)%nat -> Z.of_nat (n * (ring_size / kG)) < Z.of_nat ring_size).
-{ intros n Hn. apply Nat2Z.inj_lt.
- apply Nat.lt_le_trans with (kG * (ring_size / kG))%nat.
- - apply mult_lt_compat_r; lia.
- - apply Nat.mul_div_le. lia. }
-rewrite 2 Z.mod_small in Heq; try (split; apply Zle_0_nat || apply Hlt, proj2_sig); [].
-apply Nat2Z.inj, Nat.mul_cancel_r in Heq; auto.
-Local Transparent G. unfold G. now apply eq_proj1.
-Qed.
-
-(** Translating [ref_config] by multiples of [ring_size / kG] does not change its observation. *)
-Lemma obs_trans_ref_config : forall g,
- !! (map_config (Ring.trans (to_Z (create_ref_config g))) ref_config) == !! ref_config.
-Proof using k_sup_1 k_inf_n kdn.
-unfold obs_from_config,
- MultisetObservation.multiset_observation, MultisetObservation.make_multiset.
-intro g. apply MMultisetFacts.from_elements_compat. (* FIXME: [f_equiv] works but is too long *)
-rewrite 2 config_list_spec, 4 map_map.
-change (finite_node ring_size) with location.
-apply NoDupA_equivlistA_PermutationA; autoclass; [| |].
-* apply map_injective_NoDupA with eq; autoclass; [|].
- + intros id1 id2 [Heq _]. apply ref_config_injective.
- simpl in Heq. unfold Datatypes.id in *.
- apply (f_equal to_Z) in Heq. rewrite 2 Z2Z in Heq.
- assert (Heq_mod : (to_Z (ref_config id1)) mod Z.of_nat ring_size
- = (to_Z (ref_config id2)) mod Z.of_nat ring_size).
- { replace (to_Z (ref_config id1))
- with (to_Z (ref_config id1) - to_Z (create_ref_config g)
- + to_Z (create_ref_config g)) by ring.
- rewrite Z.add_mod, Heq, <- Z.add_mod; try lia; []. f_equal. ring. }
- rewrite 2 Z.mod_small in Heq_mod; auto using to_Z_small; [].
- apply to_Z_injective in Heq_mod. now rewrite Heq_mod.
- + rewrite NoDupA_Leibniz. apply names_NoDup.
-* apply map_injective_NoDupA with eq; autoclass; [|].
- + intros ? ? []. now apply ref_config_injective.
- + rewrite NoDupA_Leibniz. apply names_NoDup.
-* intro pt. repeat rewrite InA_map_iff; autoclass; [].
- assert (HkG : kG <> 0%nat) by lia.
- assert (Z.of_nat ring_size <> 0) by lia.
- assert (ring_size / kG <> 0)%nat by (rewrite Nat.div_small_iff; lia).
- assert (Hg : (proj1_sig g < kG)%nat) by apply proj2_sig.
- assert (Hsize : (kG * (ring_size / kG) = ring_size)%nat).
- { symmetry. now rewrite Nat.div_exact. }
- split; intros [id [Hpt _]]; revert Hpt; apply (no_byz id); clear id; intros g' Hpt.
- + assert (Hlt : ((proj1_sig g' + (kG - proj1_sig g)) mod kG < kG)%nat)
- by now apply Nat.mod_upper_bound.
- pose (id' := exist (fun x => lt x kG) _ Hlt).
- change (fin kG) with G in id'.
- exists (Good id'). split.
- - simpl. rewrite <- Hpt. simpl. split; try reflexivity; []. hnf. simpl.
- unfold Datatypes.id, create_ref_config. apply to_Z_injective. rewrite 2 Z2Z.
- (* This part is a proof about modular arithmetic; we stay in Z to use the ring structure *)
- rewrite 2 Ring.Z2Z, <- Zdiv.Zminus_mod.
- unfold id'. simpl.
- rewrite <- Nat.mul_mod_distr_r, Hsize, Zdiv.mod_Zmod, Z.mod_mod; try lia; [].
- rewrite Nat.mul_add_distr_r, Nat2Z.inj_add, 3 Nat2Z.inj_mul, Nat2Z.inj_sub; try lia; [].
- rewrite Z.mul_sub_distr_r, <- (Nat2Z.inj_mul kG), Hsize.
- rewrite Z.add_mod, Zdiv.Zminus_mod, Z.mod_same, Z.add_mod_idemp_r; try lia; [].
- rewrite Zdiv.Zminus_mod. reflexivity.
- - rewrite InA_Leibniz. apply In_names.
- + assert (Hlt : ((proj1_sig g' + proj1_sig g) mod kG < kG)%nat) by now apply Nat.mod_upper_bound.
- pose (id' := exist (fun x => lt x kG) _ Hlt).
- change (fin kG) with G in id'.
- exists (Good id'). split.
- - simpl. rewrite <- Hpt. simpl. split; try reflexivity; []. hnf. simpl.
- unfold Datatypes.id, create_ref_config. apply to_Z_injective. rewrite 2 Z2Z.
- (* This part is a proof about modular arithmetic; we stay in Z to use the ring structure *)
- rewrite 2 Ring.Z2Z, <- Zdiv.Zminus_mod.
- unfold id'. simpl.
- rewrite <- Nat.mul_mod_distr_r, Hsize, Zdiv.mod_Zmod; try lia; [].
- rewrite Zdiv.Zminus_mod_idemp_l. f_equal. lia.
- - rewrite InA_Leibniz. apply In_names.
+Proof using kdn ltc_0_k k_inf_n.
+intros id1 id2. apply (no_byz id2), (no_byz id1). clear id1 id2.
+intros g1 g2 Heq. f_equal. unfold ref_config, create_ref_config in Heq.
+eapply mod2fin_betweenI, Nat.mul_cancel_r, fin2natI in Heq; trivial;
+try (now split; [apply Nat.le_0_l | apply local_subproof3, fin_lt]).
+intro Habs. rewrite Nat.div_small_iff in Habs; try lia; []. now rewrite Nat.neq_0_lt_0.
+Qed.
+
+(** Translating [ref_config] by multiples of [n / k]
+ does not change its observation. *)
+Lemma obs_asbf_ref_config : forall g,
+ !! (map_config (λ x, subf x (create_ref_config g)) ref_config) == !! ref_config.
+Proof using kdn ltc_0_k k_inf_n.
+ unfold obs_from_config, MultisetObservation.multiset_observation,
+ MultisetObservation.make_multiset. intro g. f_equiv.
+ rewrite 2 config_list_spec, 4 map_map.
+ apply NoDupA_equivlistA_PermutationA.
+ * autoclass.
+ * apply map_injective_NoDupA with eq; autoclass; [|].
+ + intros id1 id2 [Heq _]. apply ref_config_injective. apply addIm in Heq.
+ rewrite Heq. reflexivity.
+ + rewrite NoDupA_Leibniz. apply names_NoDup.
+ * apply map_injective_NoDupA with eq; autoclass; [|].
+ + intros ? ? []. now apply ref_config_injective.
+ + rewrite NoDupA_Leibniz. apply names_NoDup.
+ * intro pt. repeat rewrite InA_map_iff; autoclass; [].
+ split; intros [id [Hpt _]]; revert Hpt; apply (no_byz id); clear id; intros g' Hpt.
+ + pose (id' := subf g' g). change (fin k) with G in id'.
+ exists (Good id'). split. 2:{ rewrite InA_Leibniz. apply In_names. }
+ rewrite <- Hpt. cbn -[create_ref_config BijectionInverse]. split; trivial; [].
+ change G with (fin k) in *. unfold create_ref_config, Datatypes.id, id'. apply fin2natI.
+ rewrite 2 subf2nat, 3 mod2fin2nat, Nat.Div0.add_mod_idemp_l, 2 (Nat.mod_small (_ * _));auto with localDB.
+ - pattern n at 3 5. rewrite local_subproof1.
+ rewrite <- Nat.mul_sub_distr_r, <- Nat.mul_add_distr_r.
+ rewrite Nat.Div0.mul_mod_distr_r;try auto with localDB.
+ - apply local_subproof3, fin_lt.
+ - pattern n at 2. rewrite local_subproof1, <- Nat.mul_lt_mono_pos_r; try apply mod2fin_lt; [].
+ apply Nat.neq_0_lt_0, local_subproof2.
+ + pose (id' := addf g' g). change (fin k) with G in id'.
+ exists (Good id'). split. 2:{ rewrite InA_Leibniz. apply In_names. }
+ rewrite <- Hpt. cbn. split. 2: reflexivity. unfold create_ref_config, id', Datatypes.id. apply fin2natI.
+ rewrite subf2nat, 3 mod2fin2nat, addf2nat, Nat.Div0.add_mod_idemp_l, 2 (Nat.mod_small (_ * _));
+ try (pattern n at 2; rewrite local_subproof1, <- Nat.mul_lt_mono_pos_r; try apply fin_lt;
+ [];
+ apply Nat.div_str_pos; split; trivial; []; now apply Nat.lt_le_incl); try lia ;[].
+ rewrite local_subproof1 at 2 4.
+ rewrite <- Nat.mul_sub_distr_r, <- Nat.mul_add_distr_r, Nat.Div0.mul_mod_distr_r; auto with localDB.
+ apply Nat.mul_cancel_r; try apply local_subproof2; [].
+ rewrite Nat.Div0.add_mod_idemp_l, <- Nat.add_assoc, (Nat.add_comm (fin2nat g)), Nat.sub_add;
+ try apply Nat.lt_le_incl, fin_lt;auto with localDB.
+ rewrite <- Nat.Div0.add_mod_idemp_r, Nat.Div0.mod_same, Nat.add_0_r;auto with localDB. apply Nat.mod_small, fin_lt.
Qed.
(** The demon activate all robots and shifts their view to be on 0. *)
Program Definition da : demonic_action := {|
activate := fun id => true;
relocate_byz := fun _ _ => dummy_loc;
- change_frame := fun config g => (to_Z (config (Good g)), false);
+ change_frame := fun config g => (config (Good g), false);
choose_update := fun _ _ _ => tt;
choose_inactive := fun _ _ => tt |}.
-Next Obligation. (* activate_compat *)
-now repeat intro.
-Qed.
+Next Obligation. (* activate_compat *) now repeat intro. Qed.
Next Obligation. (* relocate_byz_compat *)
-repeat intro. do 2 f_equal. subst. auto.
-Qed.
-Next Obligation. (* change_frame_compat *)
-now repeat intro.
-Qed.
-Next Obligation. (* choose_update_compat *)
-now repeat intro.
+ repeat intro. do 2 f_equal. subst. auto.
Qed.
+Next Obligation. (* change_frame_compat *) now repeat intro. Qed.
+Next Obligation. (* choose_update_compat *) now repeat intro. Qed.
Definition bad_demon : demon := Stream.constant da.
@@ -189,8 +172,16 @@ Proof using . coinduction Hcoind. apply FSYNC_one. Qed.
(** As all robots see the same observation, we take for instance the one at location [origin]. *)
Definition move := pgm r (!! ref_config).
-Definition target := move_along origin move.
+Definition target := move_along fin0 move.
+(** Acceptable starting configurations contain no tower,
+ that is, all robots are at different locations. *)
+Definition Valid_starting_config config : Prop :=
+ Util.Preliminary.injective (@Logic.eq ident) (@equiv _ state_Setoid) config.
+
+Definition Explore_and_Stop (r : robogram) :=
+ forall d config, Fair d -> Valid_starting_config config ->
+ ExplorationStop (execute r d config).
(** ** First case: robots do not move **)
@@ -201,279 +192,285 @@ Section NoMove.
Hypothesis Hmove : move == SelfLoop.
Lemma round_id : round r da ref_config == ref_config.
-Proof using Hmove k_inf_n k_sup_1 kdn.
-rewrite FSYNC_round_simplify; try (now split); [].
-apply no_byz_eq. intro g.
-cbn -[Ring.trans equiv ring_edge map_config].
-unfold lift. cbn -[map_config Ring.trans equiv].
-rewrite (MultisetObservation.obs_from_config_ignore_snd origin).
-rewrite obs_trans_ref_config, Hmove. cbn [move_along map_config].
-apply Bijection.retraction_section.
-Qed.
-
-Lemma NeverVisited_ref_config : forall e,
- e == execute r bad_demon ref_config ->
- exists pt, ~ Will_be_visited pt e.
-Proof using Hmove k_inf_n k_sup_1 kdn.
-intros e Heq_e. exists (of_Z 1).
-intro Hl. induction Hl as [e [g Hvisited] | e Hlater IHvisited].
-* (* FIXME: why does [rewrite Heq_e in Hvisited] fail? *)
- rewrite (Stream.hd_compat Heq_e) in Hvisited. simpl in Hvisited.
- apply (f_equal (@proj1_sig _ (fun x => lt x ring_size))) in Hvisited. revert Hvisited.
- assert (1 < ring_size / kG)%nat by (apply <- Nat.div_exact in kdn; nia).
- unfold Ring.of_Z. simpl. rewrite Z.mod_1_l, Z.mod_small; try lia; [|].
- + change 1 with (Z.of_nat 1). rewrite 2 Nat2Z.id. destruct (proj1_sig g); nia.
- + split; try apply Zle_0_nat; [].
- apply inj_lt, Nat.lt_le_trans with (kG * (ring_size / kG))%nat.
- - apply mult_lt_compat_r; try lia; []. apply proj2_sig.
- - rewrite <- Nat.div_exact in kdn; lia.
-* apply IHvisited. rewrite Heq_e, execute_tail.
- (* FIXME: why does [f_equiv] fail to find [execute_compat]? *)
- apply execute_compat; auto using round_id.
-Qed.
-
-Lemma never_visited : ~(forall pt, Will_be_visited pt (execute r bad_demon ref_config)).
-Proof using Hmove k_inf_n k_sup_1 kdn.
-intros Hw.
-destruct (NeverVisited_ref_config (reflexivity _)) as [pt Hpt].
-apply Hpt, Hw.
-Qed.
-
-Theorem no_exploration_idle : ~ Explore_and_Stop r.
-Proof using Hmove k_inf_n k_sup_1 kdn.
-intros Habs.
-destruct (Habs bad_demon ref_config) as [Hexpl _].
-apply FSYNC_implies_Fair, FYSNC_setting.
-apply ref_config_injective.
-now apply never_visited.
+Proof using Hmove kdn ltc_0_k k_inf_n.
+ unfold ltc in *.
+ rewrite FSYNC_round_simplify.
+ 2: split.
+ apply no_byz_eq. intro g.
+ cbn-[create_ref_config Bijection.BijectionInverse equiv].
+ erewrite transvE, asbfVE, obs_from_config_ignore_snd, obs_asbf_ref_config, Hmove, move_along_0.
+ rewrite Bijection.inv_inv, asbfE. apply subfVKV.
+Qed.
+
+Lemma NeverVisited_ref_config : ∀ e, e == execute r bad_demon ref_config
+ -> exists pt, ~ Will_be_visited pt e.
+Proof using Hmove kdn k_inf_n ltc_0_k.
+ intros e Heq_e. exists (mod2fin 1). intro Hl.
+ induction Hl as [e [g Hvisited] | e Hlater IHvisited].
+ * rewrite Heq_e in Hvisited. cbn in Hvisited.
+ apply (f_equal (@fin2nat n)) in Hvisited. revert Hvisited.
+ cbn-[Nat.modulo Nat.div]. rewrite local_subproof1 at 2.
+ rewrite Nat.Div0.mul_mod_distr_r, (Nat.mod_small 1), Nat.mul_eq_1.
+ intros [_ Habs].
+ apply Nat.lt_nge in k_inf_n.
+ contradiction k_inf_n.
+ rewrite local_subproof1,
+ Habs, Nat.mul_1_r. reflexivity.
+ eapply @lt_l_u. apply lt_s_u. auto.
+ * apply IHvisited. rewrite Heq_e, execute_tail. rewrite round_id. f_equiv.
+Qed.
+
+Lemma never_visited :
+ ~(∀ pt, Will_be_visited pt (execute r bad_demon ref_config)).
+Proof using Hmove kdn k_inf_n ltc_0_k.
+ intros Hw. destruct (NeverVisited_ref_config (reflexivity _)) as [pt Hpt].
+ apply Hpt, Hw.
+Qed.
+
+Theorem no_exploration_idle : ~ Explore_and_Stop r.
+Proof using Hmove k_inf_n kdn ltc_0_k.
+ intros Habs. destruct (Habs bad_demon ref_config) as [Hexpl _].
+ apply FSYNC_implies_Fair, FYSNC_setting. apply ref_config_injective.
+ now apply never_visited.
Qed.
End NoMove.
-
(** ** Second case: the robots move **)
(** *** Equality of configurations up to translation **)
(** Translating a configuration. *)
-Definition f_config config k : configuration := map_config (trans (- k)) config.
+Definition f_config config m : configuration := map_config (asbm m) config.
Instance f_config_compat : Proper (equiv ==> equiv ==> equiv) f_config.
Proof using .
-unfold f_config. repeat intro.
-apply map_config_compat; trivial; [].
-intros ? ? Heq. now repeat f_equiv.
-Qed.
-
-Lemma f_config_merge : forall config k1 k2,
- f_config (f_config config k1) k2 == f_config config (k1 + k2).
-Proof using k_inf_n k_sup_1 kdn.
-intros config k1 k2. unfold f_config. rewrite map_config_merge; autoclass; [].
-apply no_byz_eq. intro g.
-repeat split; simpl. apply to_Z_injective.
-repeat rewrite Z2Z, Z.sub_opp_r, ?Zdiv.Zplus_mod_idemp_l.
-f_equal. ring.
-Qed.
-
-Lemma f_config_swap : forall config k1 k2,
- f_config (f_config config k1) k2 == f_config (f_config config k2) k1.
-Proof using k_inf_n k_sup_1 kdn. intros. do 2 rewrite f_config_merge. f_equiv. hnf. ring. Qed.
-
-Lemma f_config_0 : forall config, f_config config 0 == config.
-Proof using . intro. unfold f_config. simpl. intro. now rewrite Z.sub_0_r, V2V. Qed.
-
-Lemma f_config_injective_local : forall k config1 config2 id,
- f_config config1 k id == f_config config2 k id -> config1 id == config2 id.
-Proof using k_inf_n k_sup_1 kdn.
-intros k config1 config2 id Heq.
-setoid_rewrite <- f_config_0. replace 0 with (k + -k) by ring.
-setoid_rewrite <- (f_config_merge _ _ _ id).
-unfold f_config at 1 3, map_config. now rewrite Heq.
-Qed.
-
-Lemma f_config_injective : forall k config1 config2,
- f_config config1 k == f_config config2 k -> config1 == config2.
-Proof using k_inf_n k_sup_1 kdn. intros * Heq ?. eapply f_config_injective_local, Heq. Qed.
-
-Lemma f_config_is_id : forall k config, f_config config k == config <-> of_Z k = origin.
-Proof using k_inf_n k_sup_1 kdn.
-intros k config. split; intro Heq.
-+ assert (g : G). { exists 0%nat. compute. lia. }
- specialize (Heq (Good g)). unfold f_config, map_config in Heq.
- simpl in Heq. rewrite Z.sub_opp_r in Heq.
- apply (f_equal to_Z) in Heq. rewrite Z2Z in Heq.
- apply to_Z_injective. rewrite Z2Z. change (to_Z origin) with 0.
- replace k with (to_Z (config (Good g)) + k - to_Z (config (Good g))) by ring.
- rewrite Zdiv.Zminus_mod, Heq, Zdiv.Zminus_mod_idemp_r, Z.sub_diag, Z.mod_0_l; lia.
-+ unfold f_config, map_config. simpl. intro id. rewrite Z.sub_opp_r.
- apply to_Z_injective. apply (f_equal to_Z) in Heq. rewrite Z2Z in *.
- rewrite Z.add_mod, Heq, Z.add_0_r, Z.mod_mod, Z.mod_small; lia || apply to_Z_small.
-Qed.
-
-Lemma f_config_same_sub : forall k config1 config2, config2 == f_config config1 k ->
- forall id id', of_Z (to_Z (config1 id) - to_Z (config1 id'))
- == of_Z (to_Z (config2 id) - to_Z (config2 id')).
+ unfold f_config. intros c1 c2 Hc m1 m2 Hm. rewrite Hc, Hm. reflexivity.
+Qed.
+
+Lemma f_config_merge : ∀ config m1 m2,
+ f_config (f_config config m1) m2 == f_config config (m1 + m2).
+Proof using k_inf_n kdn.
+ intros. unfold f_config. rewrite map_config_merge; autoclass; [].
+ intros id. cbn-[equiv]. rewrite 3 asbmE, <- (addm_mod (config id)), <- mod2fin2nat,
+ <- addmA, addm2nat, mod2fin2nat, Nat.Div0.add_mod_idemp_l;auto with localDB.
+ apply addm_mod.
+Qed.
+
+Lemma f_config_swap : ∀ config m1 m2,
+ f_config (f_config config m1) m2 == f_config (f_config config m2) m1.
+Proof using k_inf_n kdn.
+ intros. rewrite 2 f_config_merge, Nat.add_comm. reflexivity.
+Qed.
+
+Lemma f_config_0 : ∀ config, f_config config 0 == config.
+Proof using . intros * id. cbn-[equiv]. apply addm0. Qed.
+
+Lemma f_config_injective_config : ∀ m config1 config2,
+ f_config config1 m == f_config config2 m -> config1 == config2.
+Proof using k_inf_n kdn.
+ intros * Heq. eapply map_config_inj'. 2: apply Heq. apply Bijection.injective.
+Qed.
+
+Lemma f_config_injective_N : ∀ config m1 m2,
+ f_config config m1 == f_config config m2
+ -> m1 mod n == m2 mod n.
+Proof using kdn k_inf_n ltc_0_k.
+ unfold f_config. intros * Heq. specialize (Heq (Good fin0)).
+ eapply (@addm_betweenI 2 n ltc_2_n). 3: rewrite 2 addm_mod.
+ 3: apply Heq. all: split. 1,3: apply Nat.le_0_l. all: apply mod2fin_lt.
+Qed.
+
+Lemma f_config_modulo : ∀ config m,
+ f_config config (m mod n) == f_config config m.
+Proof using . intros * id. apply addm_mod. Qed.
+
+Lemma asbf_f_config : ∀ (config : configuration) (id1 id2 : ident) (m : nat),
+ asbf (config id1)â»Â¹ (config id2)
+ == asbf (f_config config m id1)â»Â¹ (f_config config m id2).
Proof using .
-intros k config1 config2 Heq id id'.
-rewrite Heq. unfold f_config. simpl. apply to_Z_injective.
-rewrite 2 Z.sub_opp_r, 4 Z2Z, <- Zdiv.Zminus_mod. f_equal. ring.
+ intros. unfold f_config. cbn-[equiv]. symmetry. apply subf_addm_addm.
Qed.
(** Two configurations are equivalent if they are equal up to a global translation. *)
-Definition equiv_config_k k config1 config2 : Prop := config2 == f_config config1 k.
-Definition equiv_config config1 config2 : Prop := exists k, equiv_config_k k config1 config2.
+Definition equiv_config_m m config1 config2 : Prop
+ := config2 == f_config config1 m.
+Definition equiv_config config1 config2 : Prop
+ := ∃ m, equiv_config_m m config1 config2.
-Lemma equiv_config_k_sym : forall k config1 config2,
- equiv_config_k k config1 config2 -> equiv_config_k (- k) config2 config1.
-Proof using k_inf_n k_sup_1 kdn.
-unfold equiv_config_k. intros k config1 config2 Hequiv.
-rewrite Hequiv, f_config_merge, <- f_config_0 at 1.
-f_equiv. hnf. ring.
+Lemma equiv_config_m_sym : ∀ m config1 config2,
+ equiv_config_m m config1 config2
+ -> equiv_config_m (@oppm 2 n ltc_2_n m) config2 config1.
+Proof using k_inf_n kdn.
+ unfold equiv_config_m. intros * Hequiv. unshelve erewrite Hequiv,
+ f_config_merge, <- f_config_modulo, (proj2 (Nat.Lcm0.mod_divide _ _));auto with localDB.
+ symmetry. apply f_config_0. apply divide_addn_oppm.
Qed.
-Lemma equiv_config_k_trans : forall k1 k2 config1 config2 config3,
- equiv_config_k k1 config1 config2 -> equiv_config_k k2 config2 config3 ->
- equiv_config_k (k1 + k2) config1 config3.
-Proof using k_inf_n k_sup_1 kdn.
-unfold equiv_config_k. intros * Hequiv12 Hequiv23.
-now rewrite Hequiv23, Hequiv12, f_config_merge.
+Lemma equiv_config_m_trans : ∀ m1 m2 config1 config2 config3,
+ equiv_config_m m1 config1 config2 -> equiv_config_m m2 config2 config3 ->
+ equiv_config_m (m1 + m2) config1 config3.
+Proof using k_inf_n kdn.
+ unfold equiv_config_m. intros * Hequiv12 Hequiv23.
+ now rewrite Hequiv23, Hequiv12, f_config_merge.
Qed.
-
Instance equiv_config_equiv : Equivalence equiv_config.
-Proof using k_inf_n k_sup_1 kdn. split.
-+ intro config. exists 0. unfold equiv_config_k. now rewrite f_config_0.
-+ intros config1 config2 [k Hk]. exists (- k). now apply equiv_config_k_sym.
-+ intros ? ? ? [k1 Hk1] [k2 Hk2]. exists (k1 + k2).
- revert Hk1 Hk2. apply equiv_config_k_trans.
+Proof using k_inf_n kdn. split.
+ + intro config. exists 0. unfold equiv_config_m. now rewrite f_config_0.
+ + intros config1 config2 [m Hm]. exists (@oppm 2 n ltc_2_n m).
+ apply (equiv_config_m_sym Hm).
+ + intros ? ? ? [m1 Hm1] [m2 Hm2]. exists (m1 + m2).
+ revert Hm1 Hm2. apply equiv_config_m_trans.
+Qed.
+
+Lemma equiv_config_mod : ∀ (m : nat) (config1 config2 : configuration),
+ equiv_config_m (m mod n) config1 config2
+ <-> equiv_config_m m config1 config2.
+Proof using .
+ intros. split; intros H id.
+ - rewrite <- f_config_modulo. apply H.
+ - rewrite f_config_modulo. apply H.
Qed.
(* It is actually an equivalence. *)
Instance eq_equiv_subrelation : subrelation equiv equiv_config.
-Proof using . intros ? ? ?. exists 0. unfold equiv_config_k. now rewrite f_config_0. Qed.
+Proof using .
+ intros. exists 0. unfold equiv_config_m. now rewrite f_config_0.
+Qed.
(** Equivalent configurations produce the same observation
hence the same answer from the robogram. *)
-Lemma config1_obs_equiv : forall config1 config2,
- equiv_config config1 config2 ->
- forall g, !! (map_config (trans (to_Z (config1 (Good g)))) config1)
- == !! (map_config (trans (to_Z (config2 (Good g)))) config2).
-Proof using k_inf_n k_sup_1 kdn.
-intros config1 config2 [offset Hequiv] g.
-f_equiv. apply no_byz_eq. intro g'. simpl.
-apply to_Z_injective. rewrite 2 Z2Z.
-unfold equiv_config_k in Hequiv. rewrite Hequiv.
-unfold f_config. simpl. rewrite 2 Z2Z, <- Zdiv.Zminus_mod.
-f_equal. ring.
-Qed.
-
-Theorem equiv_config_k_round : forall k config1 config2,
- equiv_config_k k config1 config2 -> equiv_config_k k (round r da config1) (round r da config2).
-Proof using k_inf_n k_sup_1 kdn.
-unfold equiv_config_k. intros k config1 config2 Hequiv id.
-apply (no_byz id). clear id. intro g.
-rewrite (FSYNC_round_simplify r config2 FSYNC_one).
-rewrite (f_config_compat (FSYNC_round_simplify r config1 FSYNC_one) (reflexivity k)).
-simpl. unfold f_config. simpl. apply to_Z_injective. repeat rewrite Z2Z.
-rewrite 2 Z.sub_diag, Z.sub_opp_r, Z.add_mod_idemp_l; try lia; [].
-unfold Datatypes.id. rewrite <- Z.add_assoc. setoid_rewrite Z.add_mod; try lia; [].
-do 2 f_equal.
-+ do 3 f_equiv. apply (pgm_compat r), obs_from_config_compat; try reflexivity; [].
- intro. symmetry. apply (f_config_same_sub Hequiv).
-+ rewrite Hequiv. unfold f_config. simpl. rewrite Z2Z, Z.sub_opp_r, Z.mod_mod; lia.
-Qed.
-
-Corollary equiv_config_round : forall config1 config2, equiv_config config1 config2 ->
- equiv_config (round r da config1) (round r da config2).
-Proof using k_inf_n k_sup_1 kdn. intros config1 config2 [k Hequiv]. exists k. now apply equiv_config_k_round. Qed.
+Lemma config1_obs_equiv : ∀ config1 config2, equiv_config config1 config2
+ -> ∀ g, !! (map_config (asbf (config1 (Good g))â»Â¹) config1)
+ == !! (map_config (asbf (config2 (Good g))â»Â¹) config2).
+Proof using k_inf_n kdn.
+ intros config1 config2 [offset Hequiv] g. f_equiv.
+ unfold equiv_config_m in Hequiv. rewrite Hequiv. rewrite Hequiv.
+ intros id. cbn[map_config]. apply asbf_f_config.
+Qed.
+
+Theorem equiv_config_m_round : ∀ m config1 config2,
+ equiv_config_m m config1 config2
+ -> equiv_config_m m (round r da config1) (round r da config2).
+Proof using k_inf_n kdn.
+ unfold equiv_config_m. intros * Hequiv. unfold f_config.
+ rewrite 2 (FSYNC_round_simplify r _ FSYNC_one). intros id. apply (no_byz id).
+ clear id. intro g. cbn-[equiv Bijection.BijectionInverse].
+ setoid_rewrite <- config1_obs_equiv. 2,3: reflexivity.
+ repeat rewrite Hequiv.
+ setoid_rewrite transvVE. rewrite 2 transvE, 2 asbfE, 2 asbfVE, asbmE. cbn-[f_config equiv].
+ rewrite <- 2 subf_move_along'. unfold f_config, map_config. cbn. rewrite 2 subfVKV, addm_move_along.
+ apply move_along_compat. reflexivity. apply (pgm_compat r),
+ obs_from_config_compat. 2: reflexivity. intros id. apply subf_addm_addm.
+Qed.
+Corollary equiv_config_round : ∀ config1 config2, equiv_config config1 config2
+ -> equiv_config (round r da config1) (round r da config2).
+Proof using k_inf_n kdn.
+ intros config1 config2 [m Hequiv]. exists m. now apply equiv_config_m_round.
+Qed.
(** *** Equality of executions up to translation **)
-Definition AlwaysEquiv k (e1 e2 : execution) : Prop :=
- Stream.forever2 (Stream.instant2 (equiv_config_k k)) e1 e2.
+Definition AlwaysEquiv m (e1 e2 : execution) : Prop :=
+ Stream.forever2 (Stream.instant2 (equiv_config_m m)) e1 e2.
-Lemma AlwaysEquiv_refl : forall e, AlwaysEquiv 0 e e.
+Lemma AlwaysEquiv_refl : ∀ e, AlwaysEquiv 0 e e.
Proof using .
-coinduction Hcoind.
-unfold Stream.instant2, equiv_config_k.
-now rewrite f_config_0.
+ coinduction Hcoind. unfold Stream.instant2, equiv_config_m.
+ now rewrite f_config_0.
Qed.
-Lemma AlwaysEquiv_sym : forall k (e1 e2 : execution),
- AlwaysEquiv k e1 e2 -> AlwaysEquiv (- k) e2 e1.
-Proof using k_inf_n k_sup_1 kdn.
-cofix Hcoind.
-intros k1 e1 e2 [Hnow Hlater].
-constructor.
-+ now apply equiv_config_k_sym.
-+ apply Hcoind; auto.
+Lemma AlwaysEquiv_sym : ∀ m (e1 e2 : execution),
+ AlwaysEquiv m e1 e2 -> AlwaysEquiv (@oppm 2 n ltc_2_n m) e2 e1.
+Proof using k_inf_n kdn.
+ cofix Hcoind. intros m1 e1 e2 [Hnow Hlater]. constructor.
+ + now apply equiv_config_m_sym.
+ + apply Hcoind; auto.
Qed.
-Lemma AlwaysEquiv_trans : forall k1 k2 (e1 e2 e3 : execution),
- AlwaysEquiv k1 e1 e2 -> AlwaysEquiv k2 e2 e3 -> AlwaysEquiv (k1 + k2) e1 e3.
-Proof using k_inf_n k_sup_1 kdn.
-cofix Hrec.
-intros k1 k2 e1 e2 e3 [Hnow12 Hlater12] [Hnow23 Hnlater23].
-constructor.
-+ eapply equiv_config_k_trans; eauto.
-+ apply Hrec with (Stream.tl e2); auto.
+Lemma AlwaysEquiv_trans : ∀ m1 m2 (e1 e2 e3 : execution),
+ AlwaysEquiv m1 e1 e2 -> AlwaysEquiv m2 e2 e3 -> AlwaysEquiv (m1 + m2) e1 e3.
+Proof using k_inf_n kdn.
+ cofix Hrec. intros * [Hnow12 Hlater12] [Hnow23 Hnlater23]. constructor.
+ + eapply equiv_config_m_trans; eauto.
+ + apply Hrec with (tl e2); auto.
Qed.
-Instance execute_equiv_compat : forall k,
- Proper (equiv_config_k k ==> AlwaysEquiv k) (execute r bad_demon).
-Proof using k_inf_n k_sup_1 kdn. intro k. coinduction Hrec; trivial; []. simpl. now apply equiv_config_k_round. Qed.
+Instance execute_equiv_compat : ∀ m,
+ Proper (equiv_config_m m ==> AlwaysEquiv m) (execute r bad_demon).
+Proof using k_inf_n kdn.
+ intros. coinduction Hrec; trivial; []. simpl.
+ now apply equiv_config_m_round.
+Qed.
-(** Stopping is invariant by this notion of equivalence. *)
-Instance Stall_equiv_compat : forall k, Proper (AlwaysEquiv k ==> iff) Stall.
-Proof using k_inf_n k_sup_1 kdn.
-intros k s1 s2 Hequiv. unfold Stall. destruct Hequiv as [Hequiv [Hequiv' Hlater]].
-unfold Stream.instant2, equiv_config_k in *.
-rewrite Hequiv, Hequiv'. split.
-- intro Heq. now rewrite Heq.
-- apply f_config_injective.
+Lemma AlwaysEquiv_mod : ∀ (m : nat) (e1 e2 : execution),
+ AlwaysEquiv (m mod n) e1 e2 <-> AlwaysEquiv m e1 e2.
+Proof using .
+ intros. split.
+ - revert m e1 e2. cofix Hrec. intros * H. constructor.
+ setoid_rewrite <- equiv_config_mod. apply H. apply Hrec, H.
+ - revert m e1 e2. cofix Hrec. intros * H. constructor.
+ setoid_rewrite equiv_config_mod. apply H. apply Hrec, H.
Qed.
-Lemma Stopped_equiv_compat_aux : forall k e1 e2,
- AlwaysEquiv k e1 e2 -> Stopped e1 -> Stopped e2.
-Proof using k_inf_n k_sup_1 kdn.
-cofix Hcoind. intros k e1 e2 Hequiv Hstop.
-constructor.
-+ rewrite <- (Stall_equiv_compat Hequiv). apply Hstop.
-+ destruct Hequiv. apply (Hcoind _ _ _ Hequiv), Hstop.
+(** Stopping is invariant by this notion of equivalence. *)
+Instance Stall_equiv_compat : ∀ m, Proper (AlwaysEquiv m ==> iff) Stall.
+Proof using k_inf_n kdn.
+ intros m s1 s2 Hequiv. unfold Stall.
+ destruct Hequiv as [Hequiv [Hequiv' Hlater]].
+ unfold instant2, equiv_config_m in *. rewrite Hequiv, Hequiv'. split.
+ - intro Heq. now rewrite Heq.
+ - apply f_config_injective_config.
Qed.
-Instance Stopped_equiv_compat : forall k, Proper (AlwaysEquiv k ==> iff) Stopped.
-Proof using k_inf_n k_sup_1 kdn. intros ? ? ? ?. split; eapply Stopped_equiv_compat_aux; eauto using AlwaysEquiv_sym. Qed.
+Lemma Stopped_equiv_compat_aux : ∀ m e1 e2,
+ AlwaysEquiv m e1 e2 -> Stopped e1 -> Stopped e2.
+Proof using k_inf_n kdn.
+ cofix Hcoind. intros m e1 e2 Hequiv Hstop. constructor.
+ + rewrite <- (Stall_equiv_compat Hequiv). apply Hstop.
+ + destruct Hequiv. apply (Hcoind _ _ _ Hequiv), Hstop.
+Qed.
-Instance NoStopped_equiv_compat : forall k, Proper (AlwaysEquiv k ==> iff) (fun e => ~Stopped e).
-Proof using k_inf_n k_sup_1 kdn. intros ? ? ? Hequiv. now rewrite (Stopped_equiv_compat Hequiv). Qed.
+Instance Stopped_equiv_compat : ∀ m, Proper (AlwaysEquiv m ==> iff) Stopped.
+Proof using k_inf_n kdn.
+ intros ? ? ? ?.
+ split; eapply Stopped_equiv_compat_aux; eauto using AlwaysEquiv_sym.
+Qed.
+Instance NoStopped_equiv_compat : ∀ m,
+ Proper (AlwaysEquiv m ==> iff) (fun e => ~Stopped e).
+Proof using k_inf_n kdn.
+ intros ? ? ? Hequiv. now rewrite (Stopped_equiv_compat Hequiv).
+Qed.
(** An execution that never stops is always moving. *)
Definition AlwaysMoving (e : execution) : Prop :=
- Stream.forever (fun e1 => ~Stopped e1) e.
+ forever (fun e1 => ~Stopped e1) e.
-Lemma AlwaysMoving_equiv_compat_aux : forall k e1 e2,
- AlwaysEquiv k e1 e2 -> AlwaysMoving e1 -> AlwaysMoving e2.
-Proof using k_inf_n k_sup_1 kdn.
-cofix Hcoind. intros k e1 e2 Hequiv He.
-constructor.
-+ rewrite <- (NoStopped_equiv_compat Hequiv). apply He.
-+ destruct Hequiv. apply (Hcoind _ _ _ Hequiv), He.
+Lemma AlwaysMoving_equiv_compat_aux : ∀ m e1 e2,
+ AlwaysEquiv m e1 e2 -> AlwaysMoving e1 -> AlwaysMoving e2.
+Proof using k_inf_n kdn.
+ cofix Hcoind. intros m e1 e2 Hequiv He. constructor.
+ + rewrite <- (NoStopped_equiv_compat Hequiv). apply He.
+ + destruct Hequiv. apply (Hcoind _ _ _ Hequiv), He.
Qed.
-Instance AlwaysMoving_equiv_compat : forall k, Proper (AlwaysEquiv k ==> iff) AlwaysMoving.
-Proof using k_inf_n k_sup_1 kdn.
-intros ? ? ? ?.
-split; eapply AlwaysMoving_equiv_compat_aux; eauto using AlwaysEquiv_sym.
+Instance AlwaysMoving_equiv_compat : ∀ m,
+ Proper (AlwaysEquiv m ==> iff) AlwaysMoving.
+Proof using k_inf_n kdn.
+ intros ? ? ? ?.
+ split; eapply AlwaysMoving_equiv_compat_aux; eauto using AlwaysEquiv_sym.
Qed.
-Instance AlwaysMoving_execute_compat : forall k,
- Proper (equiv_config_k k ==> iff) (fun config => AlwaysMoving (execute r bad_demon config)).
-Proof using k_inf_n k_sup_1 kdn. intros k ? ? Hequiv. apply (AlwaysMoving_equiv_compat (execute_equiv_compat Hequiv)). Qed.
-
+Instance AlwaysMoving_execute_compat : ∀ m, Proper (equiv_config_m m ==> iff)
+ (λ config, AlwaysMoving (execute r bad_demon config)).
+Proof using k_inf_n kdn.
+ intros m ? ? Hequiv.
+ apply (AlwaysMoving_equiv_compat (execute_equiv_compat Hequiv)).
+Qed.
(** *** Proof when robots move **)
@@ -484,82 +481,72 @@ Section DoesMove.
Hypothesis Hmove : move =/= SelfLoop.
(** After a round, the configuration obtained from ref_config is equivalent to ref_config. *)
-Lemma round_simplify : round r da ref_config == f_config ref_config (to_Z target).
-Proof using k_inf_n k_sup_1 kdn.
-apply no_byz_eq. intro g.
-rewrite (FSYNC_round_simplify r ref_config FSYNC_one).
-cbn -[equiv map_config trans].
-rewrite MultisetObservation.obs_from_config_ignore_snd.
-rewrite obs_trans_ref_config.
-cbn -[trans equiv]. rewrite trans_same. fold origin.
-unfold f_config, map_config. simpl. now rewrite Z.add_comm, Z.sub_opp_r.
+Lemma round_simplify : round r da ref_config == f_config ref_config target.
+Proof using k_inf_n kdn ltc_0_k.
+ rewrite (FSYNC_round_simplify _ _ FSYNC_one). apply no_byz_eq. intro g.
+ cbn-[Bijection.BijectionInverse mod2fin equiv].
+ setoid_rewrite transvVE. rewrite transvE, asbfE, asbfVE.
+ rewrite obs_from_config_ignore_snd, obs_asbf_ref_config.
+ unfold target. rewrite subff, 2 move_along0_, addfC. unfold f_config.
+ rewrite asbmE. cbn. rewrite addm_addf, <- dir2nodE. reflexivity.
Qed.
-Corollary round_ref_config : equiv_config_k (to_Z target) ref_config (round r da ref_config).
-Proof using k_inf_n k_sup_1 kdn. apply round_simplify. Qed.
+Corollary round_ref_config :
+ equiv_config_m target ref_config (round r da ref_config).
+Proof using k_inf_n kdn ltc_0_k. apply round_simplify. Qed.
Corollary AlwaysEquiv_ref_config :
- AlwaysEquiv (to_Z target) (execute r bad_demon ref_config)
- (Stream.tl (execute r bad_demon ref_config)).
-Proof using k_inf_n k_sup_1 kdn. apply execute_equiv_compat, round_simplify. Qed.
+ AlwaysEquiv target (execute r bad_demon ref_config)
+ (tl (execute r bad_demon ref_config)).
+Proof using k_inf_n kdn ltc_0_k.
+ apply execute_equiv_compat, round_simplify.
+Qed.
(** An execution that is always moving cannot stop. *)
-Lemma AlwaysMoving_not_WillStop : forall e, AlwaysMoving e -> ~Will_stop e.
+Lemma AlwaysMoving_not_WillStop : ∀ e, AlwaysMoving e -> ~Will_stop e.
Proof using .
-intros e [Hnow Hmoving] Hstop.
-induction Hstop as [e Hstop | e Hstop IHstop].
-+ contradiction.
-+ inv Hmoving. now apply IHstop.
+ intros e [Hnow Hmoving] Hstop. induction Hstop as [e Hstop | e Hstop IHstop].
+ contradiction. inv Hmoving. now apply IHstop.
Qed.
(** The starting configuration is always moving. *)
Lemma ref_config_AlwaysMoving : AlwaysMoving (execute r bad_demon ref_config).
-Proof using Hmove k_inf_n k_sup_1 kdn.
-generalize (AlwaysEquiv_refl (execute r bad_demon ref_config)).
-generalize 0, (execute r bad_demon ref_config) at 1 3.
-cofix Hcoind. intros k e Hequiv. constructor.
-+ clear Hcoind. rewrite Hequiv. intros [Hstop _].
- unfold Stall in Hstop.
- rewrite execute_tail, round_simplify in Hstop. simpl Stream.hd in Hstop.
- symmetry in Hstop. rewrite f_config_is_id in Hstop.
- apply (f_equal to_Z) in Hstop. revert Hstop.
- unfold of_Z, to_Z, target, move_along. simpl.
- destruct move; simpl; repeat rewrite Z2Nat.id; try (apply Z.mod_pos_bound; lia); [| |].
- - rewrite 2 Z.mod_1_l; lia || discriminate.
- - rewrite Z.mod_mod, <- (Z.mod_add _ 1); try lia; [].
- replace (-1 + 1 * Z.of_nat ring_size) with (Z.of_nat ring_size - 1) by ring.
- rewrite Z.mod_small; lia.
- - now elim Hmove.
-+ apply (Hcoind (k - to_Z target)). clear Hcoind.
- apply AlwaysEquiv_trans with (Stream.tl (execute r bad_demon ref_config)).
- - now inv Hequiv.
- - apply AlwaysEquiv_sym, AlwaysEquiv_ref_config.
+Proof using Hmove k_inf_n kdn ltc_0_k.
+ generalize (AlwaysEquiv_refl (execute r bad_demon ref_config)).
+ generalize 0 at 1. generalize (execute r bad_demon ref_config) at 1 3.
+ cofix Hcoind. intros e m Hequiv. constructor.
+ + clear Hcoind. rewrite Hequiv. intros [Hstop _]. contradiction Hmove.
+ unfold Stall in Hstop. rewrite execute_tail, round_simplify in Hstop.
+ simpl hd in Hstop. apply (move_along_I fin0). rewrite move_along_0.
+ apply fin2natI. setoid_rewrite <- Nat.mod_small. 2,3: apply fin_lt.
+ eapply f_config_injective_N. rewrite fin02nat, f_config_0.
+ symmetry. apply Hstop.
+ + eapply (Hcoind _ (addm (oppf target) m)). clear Hcoind. rewrite addm2nat,
+ Nat.add_comm. apply AlwaysEquiv_mod.
+ apply AlwaysEquiv_trans with (tl (execute r bad_demon ref_config)).
+ apply Hequiv. rewrite oppf_oppm.
+ apply AlwaysEquiv_sym, AlwaysEquiv_ref_config.
Qed.
(** Final theorem when robots move. *)
Theorem no_exploration_moving : ~ Explore_and_Stop r.
-Proof using Hmove k_inf_n k_sup_1 kdn.
- intros Habs.
- unfold Explore_and_Stop in *.
- destruct (Habs bad_demon ref_config) as [_ Hstop].
- apply FSYNC_implies_Fair. apply FYSNC_setting.
- unfold Valid_starting_config.
- apply ref_config_injective.
- revert Hstop.
-now apply AlwaysMoving_not_WillStop, ref_config_AlwaysMoving.
+Proof using Hmove k_inf_n kdn ltc_0_k.
+ intros Habs. unfold Explore_and_Stop in *.
+ destruct (Habs bad_demon ref_config) as [_ Hstop]. apply FSYNC_implies_Fair.
+ apply FYSNC_setting. unfold Valid_starting_config. apply ref_config_injective.
+ revert Hstop. now apply AlwaysMoving_not_WillStop, ref_config_AlwaysMoving.
Qed.
End DoesMove.
-
(** Final theorem combining both cases:
In the asynchronous model, if the number of robots [kG] divides the size [n] of the ring,
then the exploration with stop of a n-node ring is not possible. *)
Theorem no_exploration : ~ Explore_and_Stop r.
-Proof using k_inf_n k_sup_1 kdn.
-destruct (move =?= SelfLoop) as [Hmove | Hmove].
-+ now apply no_exploration_idle.
-+ now apply no_exploration_moving.
+Proof using k_inf_n kdn ltc_0_k.
+ destruct (move =?= SelfLoop) as [Hmove | Hmove].
+ + now apply no_exploration_idle.
+ + now apply no_exploration_moving.
Qed.
End Exploration.
diff --git a/CaseStudies/Exploration/Tower.v b/CaseStudies/Exploration/Tower.v
index fc378f5f1880858a17b50cfd4ecefbc3fba85a15..39c0e8ed69f271fc9fc9d022482ba5a24cbb959f 100644
--- a/CaseStudies/Exploration/Tower.v
+++ b/CaseStudies/Exploration/Tower.v
@@ -16,188 +16,171 @@
*)
(**************************************************************************)
-
Require Import Utf8.
Require Import List SetoidList.
-Require Import Decidable.
-Require Import Setoid Equalities Morphisms.
-Require Import Compare_dec FinFun.
-Require Import ZArith Arith_base Arith.Div2 Lia Psatz.
+Require Import Arith_base Lia.
+Require Import Pactole.Util.Stream.
+Require Import Pactole.Util.Enum.
+Require Import Pactole.Util.Fin.
Require Import Pactole.Models.NoByzantine.
-Require Import Pactole.CaseStudies.Exploration.Definitions.
-
+Require Import Pactole.Models.RingSSync.
+Require Import Pactole.CaseStudies.Exploration.ExplorationDefs.
Open Scope list_scope.
Set Implicit Arguments.
-Typeclasses eauto := (bfs).
+(* Typeclasses eauto := (bfs). *)
Section Tower.
(** Given an abitrary ring *)
-Context {RR : RingSpec}.
-(** There are kG good robots and no byzantine ones. *)
-Variable kG : nat.
-Instance Robots : Names := Robots kG 0.
+Context {n : nat} {ltc_2_n : 2 <c n}.
+(** There are k good robots and no byzantine ones. *)
+Context {k : nat} {ltc_0_k : 0 <c k}.
+Instance Robots : Names := Robots k 0.
(** Assumptions on the number of robots: it is non zero and strictly divides the ring size. *)
-Hypothesis kdn : (ring_size mod kG = 0)%nat.
-Hypothesis k_inf_n : (kG < ring_size)%nat.
+Hypothesis kdn : (n mod k = 0).
+Hypothesis k_inf_n : (k < n).
(** There is no byzantine robot. *)
Instance NoByz : NoByzantine.
Proof using . now split. Qed.
-Definition origin : location := of_Z 0.
-
-Notation "!! config" := (@obs_from_config _ _ _ _ multiset_observation config origin) (at level 0).
+Notation "!! config" :=
+ (@obs_from_config _ _ _ _ multiset_observation config fin0) (at level 0).
Notation execute := (execute (UpdFun := UpdFun)).
(** In order to prove that at least one position is occupied, we define the list of positions. *)
-Definition Vlist := Identifiers.enum ring_size.
+Definition Vlist := enum (n).
Lemma Vlist_NoDup : NoDupA equiv Vlist.
Proof using . rewrite NoDupA_Leibniz. apply enum_NoDup. Qed.
-Lemma Vlist_length : length Vlist = ring_size.
+Lemma Vlist_length : length Vlist = n.
Proof using . apply enum_length. Qed.
(** As there is strictly less robots than location, there is an empty location. *)
-Lemma ConfigExistsEmpty : forall config, ¬ (∀ pt, In pt (!! config)).
+Lemma ConfigExistsEmpty : ∀ config, ¬ (∀ pt, In pt (!! config)).
Proof using k_inf_n kdn.
-generalize k_inf_n; intros Hkin config Hall.
-assert (Hsize : size (!! config) < ring_size).
-{ apply le_lt_trans with (cardinal (!! config)).
- - apply size_cardinal.
- - cut (cardinal (!! config) = kG); try lia; [].
- change (cardinal (make_multiset (List.map get_location (config_list config))) = kG).
- rewrite cardinal_make_multiset, config_list_spec, map_map, map_length.
- rewrite names_length. simpl. lia. }
-assert (Hle : ring_size <= size (!! config)).
-{ rewrite size_spec.
- assert (Hobs : forall pt, InA equiv pt (support (!! config))).
- { intro pt. specialize (Hall pt). now rewrite support_spec. }
- rewrite <- Vlist_length.
- apply (Preliminary.inclA_length setoid_equiv).
- - apply Vlist_NoDup.
- - repeat intro. apply Hobs. }
-lia.
+ generalize k_inf_n; intros Hkin config Hall.
+ assert (Hsize : size (!! config) < n).
+ { apply Nat.le_lt_trans with (cardinal (!! config)). apply size_cardinal.
+ cut (cardinal (!! config) = k). intros H. rewrite H. apply k_inf_n.
+ change (cardinal (make_multiset (List.map get_location
+ (config_list config))) = k). rewrite cardinal_make_multiset,
+ config_list_spec, map_map, map_length, names_length. simpl.
+ rewrite Nat.add_0_r. reflexivity. }
+ assert (Hle : n <= size (!! config)).
+ { rewrite size_spec. assert (Hobs : ∀ pt, InA equiv pt (support (!! config))).
+ { intro pt. specialize (Hall pt). now rewrite support_spec. }
+ rewrite <- Vlist_length at 1. apply (Preliminary.inclA_length setoid_equiv).
+ apply Vlist_NoDup. repeat intro. apply Hobs. } lia.
Qed.
-Lemma Stopped_same : forall e, Stopped e -> e == Stream.tl e.
+Lemma Stopped_same : ∀ e, Stopped e -> e == Stream.tl e.
Proof using .
-cofix Hcoind. intros e Hstop. constructor.
-+ clear Hcoind. apply Hstop.
-+ apply Hcoind. apply Hstop.
+ cofix Hcoind. intros e Hstop. constructor.
+ + clear Hcoind. apply Hstop.
+ + apply Hcoind. apply Hstop.
Qed.
-Lemma Will_stop_tl : forall e, Will_stop e -> Will_stop (Stream.tl e).
+Lemma Will_stop_tl : ∀ e, Will_stop e -> Will_stop (Stream.tl e).
Proof using .
-intros e He. induction He.
-+ left. match goal with H : Stopped _ |- _ => apply H end.
-+ right. apply IHHe.
+ intros e He. induction He.
+ + left. match goal with H : Stopped _ |- _ => apply H end.
+ + right. apply IHHe.
Qed.
+(** Acceptable starting configurations contain no tower,
+ that is, all robots are at different locations. *)
+Definition Valid_starting_config config : Prop :=
+ Util.Preliminary.injective (@Logic.eq ident) (@equiv _ state_Setoid) config.
+
+Definition Explore_and_Stop (r : robogram) :=
+ forall d config, Fair d -> Valid_starting_config config ->
+ ExplorationStop (execute r d config).
+
(** No algorithm can stop on a starting configuration. *)
-Theorem no_stop_on_starting_config : forall r d config,
- Fair d ->
- Explore_and_Stop r ->
- Valid_starting_config config ->
- ~Stopped (execute r d config).
+Theorem no_stop_on_starting_config : ∀ r d config,
+ Fair d -> Explore_and_Stop r -> Valid_starting_config config ->
+ ~ Stopped (execute r d config).
Proof using k_inf_n kdn.
-intros r d config.
-generalize (@reflexivity execution equiv _ (execute r d config)).
-generalize (execute r d config) at -2.
-intros e Heqe Hfair Hsol Hvalid Hsto.
-destruct (Hsol d config Hfair Hvalid) as [Hvisit Hstop].
-assert (Hfalse := ConfigExistsEmpty config).
-(* TODO: remove the use of classical logic: everything is decidable here *)
-apply Logic.Classical_Pred_Type.not_all_ex_not in Hfalse.
-destruct Hfalse as [loc Hfalse].
-specialize (Hvisit loc).
-rewrite <- Heqe in *.
-induction Hvisit.
-+ rewrite Heqe in *.
- match goal with H : Stream.instant _ _ |- _ => destruct H as [g Hg] end.
- rewrite (obs_from_config_In config origin) in Hfalse;
- destruct Hfalse.
- exists (Good g).
- apply Hg.
-+ apply IHHvisit.
- - rewrite <- Heqe. symmetry. now apply Stopped_same.
- - apply Hsto.
- - now apply Will_stop_tl.
+ intros r d config.
+ generalize (@reflexivity execution equiv _ (execute r d config)).
+ generalize (execute r d config) at -2.
+ intros e Heqe Hfair Hsol Hvalid Hsto.
+ destruct (Hsol d config Hfair Hvalid) as [Hvisit Hstop].
+ assert (Hfalse := ConfigExistsEmpty config).
+ (* TODO: remove the use of classical logic: everything is decidable here *)
+ apply Logic.Classical_Pred_Type.not_all_ex_not in Hfalse.
+ destruct Hfalse as [loc Hfalse]. specialize (Hvisit loc).
+ rewrite <- Heqe in *. induction Hvisit.
+ + rewrite Heqe in *.
+ match goal with H : Stream.instant _ _ |- _ => destruct H as [g Hg] end.
+ rewrite (obs_from_config_In config fin0) in Hfalse; destruct Hfalse.
+ exists (Good g). apply Hg.
+ + apply IHHvisit.
+ - rewrite <- Heqe. symmetry. now apply Stopped_same.
+ - apply Hsto.
+ - now apply Will_stop_tl.
Qed.
(** In particular, there is a tower on any final configuration. *)
-Lemma tower_on_final_config : forall r d config,
- Fair d ->
- Explore_and_Stop r ->
- Stopped (execute r d config) ->
- exists loc, ((!! config)[loc] > 1)%nat.
+Lemma tower_on_final_config : ∀ r d config, Fair d -> Explore_and_Stop r
+ -> Stopped (execute r d config) -> ∃ loc, (!! config)[loc] > 1.
Proof using k_inf_n kdn.
-intros r d config Hfair Hsol Hstop.
-assert (Hequiv := @no_stop_on_starting_config r d config Hfair Hsol).
-assert (Hvalid : ~Valid_starting_config config) by tauto.
-apply config_not_injective in Hvalid.
-destruct Hvalid as [id [id' [Hid Heq]]].
-exists (config id).
-assert (Hobs := obs_from_config_spec config origin (config id)).
-assert (Hperm : exists l, PermutationA equiv (config_list config) (config id :: config id' :: l)).
-{ assert (Hin : List.In id names) by apply In_names.
- assert (Hin' : List.In id' names) by apply In_names.
- assert (Hperm : exists l, PermutationA eq names (id :: id' :: l)).
- { rewrite <- InA_Leibniz in Hin, Hin'.
- apply PermutationA_split in Hin; autoclass; [].
- destruct Hin as [l' Hperm']. rewrite Hperm', InA_cons in Hin'.
- destruct Hin' as [| Hin']; try congruence; [].
- apply PermutationA_split in Hin'; autoclass; [].
- destruct Hin' as [l Hperm]. exists l. now rewrite Hperm', Hperm. }
- destruct Hperm as [l Hperm].
- exists (List.map config l).
- now rewrite config_list_spec, Hperm. }
-destruct Hperm as [l Hperm].
-rewrite Hobs.
-(* FIXME: why does [rewrite Hperm] fail here? *)
-rewrite (countA_occ_compat _ equiv_dec _ _ (reflexivity (config id))
- (PermutationA_map _ _ Hperm)).
-simpl List.map. rewrite List.map_id. unfold Datatypes.id. simpl.
-repeat destruct_match; solve [lia | exfalso; auto].
+ intros r d config Hfair Hsol Hstop.
+ assert (Hequiv := @no_stop_on_starting_config r d config Hfair Hsol).
+ assert (Hvalid : ~Valid_starting_config config) by tauto.
+ apply config_not_injective in Hvalid. destruct Hvalid as [id [id' [Hid Heq]]].
+ exists (config id).
+ assert (Hobs := obs_from_config_spec config fin0 (config id)).
+ assert (Hperm : exists l, PermutationA equiv (config_list config)
+ (config id :: config id' :: l)).
+ { assert (Hin : List.In id names) by apply In_names.
+ assert (Hin' : List.In id' names) by apply In_names.
+ assert (Hperm : exists l, PermutationA eq names (id :: id' :: l)).
+ { rewrite <- InA_Leibniz in Hin, Hin'.
+ apply PermutationA_split in Hin; autoclass; [].
+ destruct Hin as [l' Hperm']. rewrite Hperm', InA_cons in Hin'.
+ destruct Hin' as [| Hin']; try congruence; [].
+ apply PermutationA_split in Hin'; autoclass; [].
+ destruct Hin' as [l Hperm]. exists l. now rewrite Hperm', Hperm. }
+ destruct Hperm as [l Hperm]. exists (List.map config l).
+ now rewrite config_list_spec, Hperm. }
+ destruct Hperm as [l Hperm]. rewrite Hobs.
+ (* FIXME: why does [rewrite Hperm] fail here? *)
+ rewrite (countA_occ_compat _ equiv_dec _ _ (reflexivity (config id))
+ (PermutationA_map _ _ Hperm)).
+ simpl List.map. rewrite List.map_id. unfold Datatypes.id. simpl.
+ repeat destruct_match; solve [lia | exfalso; auto].
Qed.
-Lemma exec_stopped r : forall d c, Fair d -> Will_stop (execute r d c) ->
- exists d' c', Fair d'/\ Stopped (execute r d' c').
-(*exists e, exec_r_comp e r /\ Stopped e.*)
+Lemma exec_stopped (r : robogram) :
+ ∀ (d : demon) (c : configuration), Fair d -> Will_stop (execute r d c)
+ -> exists d' c', Fair d'/\ Stopped (execute r d' c').
Proof using .
-intros d' config' Hfair Hstop.
-remember (execute r d' config') as e'.
-revert Heqe'.
-revert d' config' Hfair.
-induction Hstop as [e' Hstop | e' Hstop IHstop].
-+ intros d' config' Hfair Heq.
- exists d', config'; now rewrite Heq in *.
-+ intros d' config' Hfair Heq.
- apply (IHstop (Stream.tl d') (Stream.hd (Stream.tl e'))).
- - destruct Hfair as [_ Hfair]. constructor; apply Hfair.
- - now rewrite Heq, execute_tail.
+ intros d' config' Hfair Hstop. remember (execute r d' config') as e'.
+ revert Heqe'. revert d' config' Hfair.
+ induction Hstop as [e' Hstop | e' Hstop IHstop].
+ + intros d' config' Hfair Heq. exists d', config'; now rewrite Heq in *.
+ + intros d' config' Hfair Heq.
+ apply (IHstop (tl d') (hd (tl e'))).
+ - destruct Hfair as [_ Hfair]. constructor; apply Hfair.
+ - now rewrite Heq, execute_tail.
Qed.
-Lemma no_exploration_k_inf_2 : forall r d config,
- Fair d ->
- Explore_and_Stop r ->
- Valid_starting_config config ->
- (kG > 1)%nat.
+Lemma no_exploration_k_inf_2 : ∀ r d config,
+ Fair d -> Explore_and_Stop r -> Valid_starting_config config -> k > 1.
Proof using k_inf_n kdn.
-intros r d config Hfair Hsol Hvalid.
-assert (Hexr := exec_stopped r).
-assert (Htower := tower_on_final_config).
-destruct (Hsol d config Hfair Hvalid) as [Hvisit Hstop].
-destruct (Hexr d config Hfair Hstop) as [d' [config' [Hfair' Hstop']]].
-specialize (Htower r d' config' Hfair' Hsol Hstop').
-destruct Htower.
-assert (Hcard := cardinal_lower x (!! config')).
-rewrite cardinal_obs_from_config in Hcard.
-unfold nG, nB in *.
-unfold Robots in *. simpl in *. lia.
+ intros r d config Hfair Hsol Hvalid. assert (Hexr := exec_stopped r).
+ assert (Htower := tower_on_final_config).
+ destruct (Hsol d config Hfair Hvalid) as [Hvisit Hstop].
+ destruct (Hexr d config Hfair Hstop) as [d' [config' [Hfair' Hstop']]].
+ specialize (Htower r d' config' Hfair' Hsol Hstop'). destruct Htower.
+ assert (Hcard := cardinal_lower x (!! config')).
+ rewrite cardinal_obs_from_config in Hcard. unfold nG, nB in *.
+ unfold Robots in *. simpl in *. lia.
Qed.
End Tower.
diff --git a/CaseStudies/Gathering/Definitions.v b/CaseStudies/Gathering/Definitions.v
index ba3dd1deab90014a45aea33538490ed14084cd9d..c144450b85e8f43e5dcaa5421c887b3c94df78f0 100644
--- a/CaseStudies/Gathering/Definitions.v
+++ b/CaseStudies/Gathering/Definitions.v
@@ -19,7 +19,6 @@
(**************************************************************************)
-Require Import Arith.Div2.
Require Import Lia.
Require Export SetoidDec.
Require Export Pactole.Util.Preliminary.
diff --git a/CaseStudies/Gathering/Impossibility.v b/CaseStudies/Gathering/Impossibility.v
index d1a8d363ff8be4984effa07b47f4ffde19504a6d..ac16573c37feb01dc71961afa10365f782bd526d 100644
--- a/CaseStudies/Gathering/Impossibility.v
+++ b/CaseStudies/Gathering/Impossibility.v
@@ -17,17 +17,13 @@
This file is distributed under the terms of the CeCILL-C licence. *)
(**************************************************************************)
-Require Import Reals.
-Require Import Psatz.
-Require Import Morphisms.
-Require Import Arith.Div2.
-Require Import Lia.
-Require Import List SetoidList.
-Require Import Pactole.Util.Preliminary.
+Require Import Reals Psatz Morphisms Lia List SetoidList.
+From Pactole Require Import Util.Preliminary Util.Fin.
+Require Import Pactole.Util.Bijection.
Require Import Pactole.Setting.
Require Import Pactole.Spaces.EuclideanSpace.
Require Import Pactole.CaseStudies.Gathering.Definitions.
-Require Pactole.CaseStudies.Gathering.WithMultiplicity.
+Require Import Pactole.CaseStudies.Gathering.WithMultiplicity.
Import Pactole.Observations.MultisetObservation.
Require Import Pactole.Models.Rigid.
Require Import Pactole.Models.NoByzantine.
@@ -35,11 +31,12 @@ Set Implicit Arguments.
Close Scope R_scope.
Close Scope VectorSpace_scope.
Import Datatypes. (* To recover Datatypes.id *)
-Typeclasses eauto := (bfs).
Remove Hints eq_setoid : typeclass_instances.
(* TODO: make equiv not unfolded everywhere. *)
Arguments equiv : simpl never.
+(* this will become non default soon. *)
+Ltac Tauto.intuition_solver ::= auto with *.
Section ImpossibilityProof.
@@ -56,7 +53,7 @@ Hypothesis nG_non_0 : n <> 0.
Local Transparent G B.
(** The setting is an arbitrary metric space over R. *)
-Context `{Location}.
+Context `{Loc:Location}.
(* Instance St : State location := OnlyLocation (fun _ => True). *)
Context {VS : RealVectorSpace location}.
Context {ES : EuclideanSpace location}.
@@ -121,7 +118,7 @@ assert (Heven := even_nG). assert (HnG0 := nG_non_0).
simpl. destruct n as [| [| ?]].
- lia.
- destruct Heven. lia.
-- simpl. lia.
+- simpl. solve [ auto with arith | lia].
Qed.
(* We need to unfold [obs_is_ok] for rewriting *)
@@ -130,7 +127,7 @@ Definition obs_from_config_spec : forall config (pt : location),
:= WithMultiplicity.obs_from_config_spec.
Definition mk_info : location -> location := id.
-Arguments mk_info _%VectorSpace_scope.
+Arguments mk_info _%_VectorSpace_scope.
Lemma mk_info_get_location : forall pt, get_location (mk_info pt) == pt.
Proof using . reflexivity. Qed.
(*
@@ -144,6 +141,9 @@ Proof. simpl. repeat intro. now subst. Qed.
(* To avoid passing the [nB = 0] argument each time. *)
Definition invalid_dec := WithMultiplicity.invalid_dec (reflexivity nB).
+Existing Instance app_eqlistA_compat.
+
+
(** From [elements], we can rebuild the [config_list]. *)
Lemma obs_makes_config_list : forall config : configuration,
PermutationA equiv (List.map get_location (config_list config))
@@ -160,7 +160,10 @@ assert (Hcompat : Proper (PermutationA equiv ==> PermutationA equiv ==> Permutat
revert l1 l1' Hl1. pattern l2, l2'.
apply PermutationA_ind_bis with equiv; autoclass.
+ intros [] [] ? ? [Hl Hn] Hperm Hrec ? ? ?. simpl in *.
- rewrite Hn, Hl at 1. unfold equiv. now rewrite Hrec.
+ hnf in Hn.
+ rewrite Hl at 1.
+ rewrite Hn.
+ unfold equiv. now rewrite Hrec.
+ intros [] [] ? ? Hperm Hrec ? ? ?. simpl. rewrite Hrec, 2 app_assoc; try eassumption; [].
f_equiv. apply PermutationA_app_comm; autoclass.
+ intros ? ? ? Hperm1 Hperm2 Hperm Hrec ? ? ?.
@@ -204,7 +207,7 @@ destruct (Nat.eq_dec (from_elements (List.map (fun x : location => (x, 1)) l))[e
change (InA eq_pair (e, (from_elements (List.map (fun y => (y, 1)) l))[e])
(elements (from_elements (List.map (fun y => (y, 1)) l)))).
rewrite elements_spec; simpl.
- split; trivial; []. apply neq_0_lt. auto.
+ split; trivial; []. apply Nat.neq_0_lt_0. auto.
-- revert_all.
rewrite removeA_InA; autoclass. tauto.
Qed.
@@ -244,7 +247,7 @@ Hint Resolve half_size_config : core.
Definition lift_config {A} (config : G -> A) : ident -> A := fun id =>
match id with
| Good g => config g
- | Byz b => ltac:(exfalso; now apply (Nat.nlt_0_r (proj1_sig b)), proj2_sig)
+ | Byz b => ltac:(exfalso; now apply (Nat.nlt_0_r (fin2nat b)), fin_lt)
end.
Local Opaque G B.
@@ -312,8 +315,8 @@ assert (Hperm : PermutationA equiv (pt1 :: pt2 :: nil) (pt3 :: pt4 :: nil)).
revert Hobs. rewrite 2 support_add; auto; [].
destruct (In_dec pt3 (singleton pt4 (Nat.div2 nG))) as [Habs |];
[| destruct (In_dec pt1 (singleton pt2 (Nat.div2 nG))) as [Habs |]].
- - rewrite In_singleton in Habs. now elim Hdiff'.
- - rewrite In_singleton in Habs. now elim Hdiff.
+ - rewrite In_singleton in Habs. now contradiction Hdiff'.
+ - rewrite In_singleton in Habs. now contradiction Hdiff.
- rewrite 2 support_singleton; auto; []. now symmetry. }
repeat destruct_match; simpl; rewrite Hgh in *; intro.
+ assert (Heq1 : pt1 == pt3) by now transitivity (get_location (config2 (Good h))).
@@ -364,7 +367,7 @@ assert (Heven : Nat.Even nG).
repeat split; trivial; [|].
+ rewrite <- Nat.even_spec in Heven.
assert (HnG := nG_non_0). simpl nG in *.
- destruct n as [| [| ?]]; simpl; discriminate || lia || now elim HnG.
+ destruct n as [| [| ?]]; simpl; discriminate || lia || now contradiction HnG.
+ exists (sim origin), (sim one).
repeat split.
- intro Heq. apply Similarity.injective in Heq. symmetry in Heq. revert Heq. apply non_trivial.
@@ -465,20 +468,20 @@ destruct (invalid_dec config) as [Hvalid | Hvalid].
rewrite In_singleton in Hin, Hin';
try solve [ simpl in *; tauto ]; [|].
- destruct Hin' as [Hin' _]. apply Similarity.injective in Hin'.
- symmetry in Hin'. elim (non_trivial Hin').
+ symmetry in Hin'. contradiction (non_trivial Hin').
- rewrite 2 support_singleton; auto. }
rewrite PermutationA_2 in Hperm; autoclass; [].
destruct_match.
+ assert (Hpt1 : sim origin == pt1) by (etransitivity; eauto).
assert (Hpt2 : sim one == pt2).
- { decompose [and or] Hperm; auto; []. rewrite Hpt1 in *. now elim Hdiff. }
+ { decompose [and or] Hperm; auto; []. rewrite Hpt1 in *. now contradiction Hdiff. }
now rewrite <- Hpt2.
+ assert (Hpt2 : sim origin == pt2).
{ destruct (Hcase (Good g)); try contradiction; []. etransitivity; eauto. }
assert (Hpt1 : sim one == pt1).
- { decompose [and or] Hperm; auto; []. rewrite Hpt2 in *. now elim Hdiff. }
+ { decompose [and or] Hperm; auto; []. rewrite Hpt2 in *. now contradiction Hdiff. }
now rewrite <- Hpt1.
-* elim Hvalid.
+* contradiction Hvalid.
apply (invalid_reverse (build_similarity non_trivial Hdiff)).
rewrite Hobs. unfold observation0.
rewrite map_add, map_singleton, build_similarity_eq1, build_similarity_eq2; autoclass; [].
@@ -504,7 +507,7 @@ assert (Hconfig : round r da1 config == map_config (lift (existT precondition si
destruct (Hcase (Good g)) as [Hg' | Hg']; rewrite Hg' in *;
solve [ symmetry; apply build_similarity_eq1
| symmetry; apply build_similarity_eq2
- | auto; now elim Hg ]. }
+ | auto; now contradiction Hg ]. }
(* Let us pick an arbitrary robot (here [g0]) and consider a similarity [sim1]
that maps [!! config] to [observation0] and such that [sim1 g0 = origin]. *)
destruct (invalid_obs Hvalid g0) as [sim1 Hsim1 ?].
@@ -654,13 +657,13 @@ destruct (invalid_dec config) as [Hvalid | Hvalid].
assert (Hin := pos_in_config config origin id).
rewrite Hobs', add_In,In_singleton in Hin0, Hin.
destruct Hin as [[] | []], Hin0 as [[] | []];
- tauto || elim Hdiff; etransitivity; eauto. }
+ tauto || contradiction Hdiff; etransitivity; eauto. }
exists (symmetry Hdiff).
repeat destruct_match; simpl in *; destruct Hcase as [[] | []];
unfold Datatypes.id in *;
try solve [ congruence
| now apply Hb2; auto
- | elim Hdiff'; transitivity (config (Good g0)); auto ].
+ | contradiction Hdiff'; transitivity (config (Good g0)); auto ].
+ contradiction.
Qed.
@@ -814,7 +817,10 @@ intros config g Hinvalid.
pose (sim := change_frame2 config g). fold sim.
unfold observation0. rewrite map_add, map_singleton; autoclass; [].
assert (Hdiff_sim : simâ»Â¹ origin =/= simâ»Â¹ one).
-{ intro Habs. apply Similarity.injective in Habs. now apply non_trivial. }
+{ intro Habs. apply Similarity.injective in Habs.
+ Typeclasses eauto := (bfs).
+ now apply non_trivial.
+ Typeclasses eauto := (dfs). }
destruct (WithMultiplicity.invalid_strengthen (reflexivity _) Hinvalid) as [pt1 [pt2 Hdiff Hobs]].
assert (Hin0 : In (simâ»Â¹ origin) (!! config)).
{ change (In (Similarity.center sim) (!! config)).
@@ -836,9 +842,9 @@ assert (Hin1 : In (simâ»Â¹ one) (!! config)).
intro pt. rewrite Hobs, 2 add_spec, 2 singleton_spec.
repeat destruct_match;
solve [ lia
- | elim Hdiff; transitivity pt; eauto
- | elim Hdiff_sim; transitivity pt; eauto
- | elim Hdiff_sim;
+ | contradiction Hdiff; transitivity pt; eauto
+ | contradiction Hdiff_sim; transitivity pt; eauto
+ | contradiction Hdiff_sim;
apply (WithMultiplicity.invalid_same_location (reflexivity _) Hinvalid (pt3 := pt)); auto; try (now symmetry); [];
rewrite Hobs, add_In, In_singleton; auto
| rewrite Hobs, add_In, In_singleton in Hin0, Hin1;
@@ -912,7 +918,7 @@ destruct_match_eq Hcase.
* (* The robot is on the second tower so it does not move. *)
rewrite activate2_spec2 in Hcase; trivial; [].
fold sim.
- destruct_match; reflexivity || now elim Hcase; etransitivity; eauto.
+ destruct_match; reflexivity || now contradiction Hcase; etransitivity; eauto.
Qed.
Lemma invalid_da2_left_next : forall config,
@@ -942,7 +948,10 @@ assert (Hconfig : round r (da2_left config) config
- rewrite Hobs. unfold observation0. rewrite map_add, map_singleton, add_In, In_singleton; autoclass.
- rewrite Hobs. unfold observation0. rewrite map_add, map_singleton, add_In, In_singleton; autoclass.
- assumption.
- - intro Habs. apply Similarity.injective in Habs. now apply non_trivial. }
+ - intro Habs. apply Similarity.injective in Habs.
+ Typeclasses eauto := (bfs).
+ now apply non_trivial.
+ Typeclasses eauto := (dfs). }
rewrite Heq'. cbn -[equiv sim']. rewrite Bijection.section_retraction.
unfold sim'. now rewrite build_similarity_eq2. }
rewrite Hconfig.
@@ -967,7 +976,10 @@ do 2 destruct_match.
+ split; intro Heq.
- etransitivity; eauto.
- rewrite change_frame2_eq in Heq; trivial; []. now rewrite Heq.
-+ revert_one equiv. intro Heq1. rewrite Heq1.
++ Typeclasses eauto := (bfs).
+ revert_one equiv.
+ Typeclasses eauto := (dfs).
+ intro Heq1. rewrite Heq1.
change ((sim â»Â¹) 0%VS) with (Similarity.center sim) in Heq1.
unfold sim in Heq1. rewrite center_change_frame2, change_frame2_eq in Heq1; trivial; [].
assert (Heq2 : get_location (config (Good g2)) == (sim â»Â¹) one).
@@ -976,8 +988,12 @@ do 2 destruct_match.
rewrite map_add, map_singleton, add_In, In_singleton in Hin; autoclass; [].
now destruct Hin as [[] | []]. }
rewrite Heq2, Heq1. fold sim.
- split; intro Heq; apply Similarity.injective in Heq; contradiction || now elim non_trivial.
+ split; intro Heq; apply Similarity.injective in Heq.
+ * contradiction.
+ * Typeclasses eauto := (bfs).
+ now elim non_trivial.
+ revert_one equiv. intro Heq2. rewrite Heq2.
+ Typeclasses eauto := (dfs).
change ((sim â»Â¹) 0%VS) with (Similarity.center sim) in Heq2.
unfold sim in Heq2. rewrite center_change_frame2, change_frame2_eq in Heq2; trivial; [].
assert (Heq1 : get_location (config (Good g1)) == (sim â»Â¹) one).
@@ -986,7 +1002,11 @@ do 2 destruct_match.
rewrite map_add, map_singleton, add_In, In_singleton in Hin; autoclass; [].
now destruct Hin as [[] | []]. }
rewrite Heq2, Heq1. fold sim.
- split; intro Heq; apply Similarity.injective in Heq; (now symmetry in Heq) || now elim non_trivial.
+ split; intro Heq; apply Similarity.injective in Heq.
+ * now symmetry in Heq.
+ * Typeclasses eauto := (bfs).
+ now elim non_trivial.
+ Typeclasses eauto := (dfs).
+ split; intro; solve [ etransitivity; eauto ].
Qed.
@@ -1013,18 +1033,25 @@ destruct_match_eq Hcase.
rewrite map_add, map_singleton, add_In, In_singleton in Hin; autoclass; [].
destruct Hin as [[] | []]; trivial; [].
rewrite activate2_spec2 in Hcase; trivial; [].
- elim Hcase. etransitivity; eauto; []. now apply center_change_frame2. }
+ contradiction Hcase. etransitivity; eauto; []. now apply center_change_frame2. }
rewrite (obs_from_config_ignore_snd origin).
assert (Hobs' : observation0 == map (change_frame2 config g) (!! config)).
- { rewrite <- map_id. Time change id with (Bijection.section Similarity.id).
+ { rewrite <- map_id.
+ Typeclasses eauto := (bfs).
+ Time change id with (Bijection.section Similarity.id).
+ Typeclasses eauto := (dfs).
rewrite <- (map_extensionality_compat _ _ (Similarity.compose_inverse_r (change_frame2 config g))).
rewrite (change_frame2_obs g Hinvalid), map_merge; autoclass. }
rewrite obs_from_config_ignore_snd, <- obs_from_config_map, <- Hobs'; autoclass; [].
destruct_match; try reflexivity; [].
- fold move. rewrite Hsim0 in *. elim non_trivial. eapply Similarity.injective; eauto.
+ fold move. rewrite Hsim0 in *.
+ Typeclasses eauto := (bfs).
+ contradiction non_trivial.
+ eapply Similarity.injective; eauto.
* (* The robot is on the first tower so it does not move. *)
destruct_match; try reflexivity; [].
exfalso. revert_one equiv. intro Heq.
+ Typeclasses eauto := (dfs).
rewrite activate2_spec1 in Hcase; trivial; []. contradict Hcase.
now rewrite <- (center_change_frame2 g0).
Qed.
@@ -1044,7 +1071,10 @@ pose (sim1 := change_frame2 config g1).
assert (Hdiff : get_location (config (Good g0)) =/= get_location (config (Good g1))).
{ rewrite Hg1, <- center_change_frame2; trivial; [].
unfold Similarity.center. fold sim0. intro Habs.
- apply Similarity.injective in Habs. now apply non_trivial. }
+ apply Similarity.injective in Habs.
+ Typeclasses eauto := (bfs).
+ now apply non_trivial.
+ Typeclasses eauto := (dfs). }
assert (Hobs1 := change_frame2_obs g1 Hinvalid). fold sim1 in Hobs1.
assert (Hg0 : get_location (config (Good g0)) == (sim1 â»Â¹) one).
{ apply (WithMultiplicity.invalid_same_location (reflexivity _) Hinvalid (pt3 := (sim1 â»Â¹) 0%VS)).
@@ -1052,7 +1082,10 @@ assert (Hg0 : get_location (config (Good g0)) == (sim1 â»Â¹) one).
- rewrite Hobs1. unfold observation0. rewrite map_add, map_singleton, add_In, In_singleton; autoclass.
- rewrite Hobs1. unfold observation0. rewrite map_add, map_singleton, add_In, In_singleton; autoclass.
- change ((sim1 â»Â¹) 0%VS) with (Similarity.center sim1). unfold sim1. now rewrite center_change_frame2.
- - intro Habs. apply Similarity.injective in Habs. now apply non_trivial. }
+ - intro Habs. apply Similarity.injective in Habs.
+ Typeclasses eauto := (bfs).
+ now apply non_trivial.
+ Typeclasses eauto := (dfs). }
assert (Hdiff_move0 : sim0â»Â¹ move =/= sim0â»Â¹ one).
{ intro Heq. now apply Similarity.injective in Heq. }
assert (Hdiff_move1 : sim1â»Â¹ move =/= sim1â»Â¹ one).
@@ -1074,7 +1107,10 @@ assert (Hconfig : round r (da2_right config) config
- rewrite Hobs0. unfold observation0. rewrite map_add, map_singleton, add_In, In_singleton; autoclass.
- rewrite Hobs0. unfold observation0. rewrite map_add, map_singleton, add_In, In_singleton; autoclass.
- assumption.
- - intro Habs. apply Similarity.injective in Habs. now apply non_trivial. }
+ - intro Habs. apply Similarity.injective in Habs.
+ Typeclasses eauto := (bfs).
+ now apply non_trivial.
+ Typeclasses eauto := (dfs). }
rewrite Heq'. cbn -[equiv sim']. rewrite Bijection.section_retraction.
unfold sim'. rewrite build_similarity_eq1.
rewrite <- Hg1, change_frame2_eq in Heq'; trivial; []. now rewrite Heq'. }
@@ -1105,10 +1141,15 @@ pose (sim1 := change_frame2 config g3).
assert (Hdiff : get_location (config (Good g0)) =/= get_location (config (Good g3))).
{ rewrite Hg3, <- center_change_frame2; trivial; [].
unfold Similarity.center. fold sim0. intro Habs.
- apply Similarity.injective in Habs. now apply non_trivial. }
+ apply Similarity.injective in Habs.
+ Typeclasses eauto := (bfs).
+ now apply non_trivial.
+ Typeclasses eauto := (dfs). }
do 2 destruct_match.
+ reflexivity.
-+ revert_one equiv. intro Heq1. rewrite Heq1.
++ Typeclasses eauto := (bfs).
+ revert_one equiv. intro Heq1. rewrite Heq1.
+ Typeclasses eauto := (dfs).
split; intro Heq.
- destruct (change_frame2_case g3 Hinvalid (symmetry Hdiff) g2) as [Hcase | Hcase].
* rewrite <- Hcase. now apply center_change_frame2.
@@ -1119,11 +1160,13 @@ do 2 destruct_match.
{ rewrite Hobs0. unfold observation0. rewrite map_add, map_singleton, add_In, In_singleton; autoclass. }
rewrite (change_frame2_obs g3 Hinvalid) in Hin. fold sim1 in Hin.
unfold observation0 in Hin. rewrite map_add, map_singleton, add_In, In_singleton in Hin; autoclass.
- decompose [and or] Hin; trivial; elim Hdiff; []. now rewrite <- 2 center_change_frame2. }
+ decompose [and or] Hin; trivial; contradiction Hdiff; []. now rewrite <- 2 center_change_frame2. }
rewrite Hcase in Heq. fold sim0 sim1 in Heq. rewrite Heq in Habs.
apply Similarity.injective in Habs. contradiction.
- symmetry in Heq. contradiction.
-+ revert_one equiv. intro Heq2. rewrite Heq2.
++ Typeclasses eauto := (bfs).
+ revert_one equiv. intro Heq2. rewrite Heq2.
+ Typeclasses eauto := (dfs).
change ((change_frame2 config g0 â»Â¹) 0%VS) with (Similarity.center (change_frame2 config g0)) in Heq2.
rewrite center_change_frame2, change_frame2_eq in Heq2; trivial; [].
assert (Heq1 : get_location (config (Good g1)) == (sim0 â»Â¹) one).
@@ -1132,7 +1175,10 @@ do 2 destruct_match.
rewrite map_add, map_singleton, add_In, In_singleton in Hin; autoclass; [].
now destruct Hin as [[] | []]. }
rewrite Heq1.
- split; intro Heq; try (apply Similarity.injective in Heq; now elim non_trivial); [].
+
+ Typeclasses eauto := (bfs).
+ split; intro Heq; try (apply Similarity.injective in Heq; now contradiction non_trivial); [].
+ Typeclasses eauto := (dfs).
destruct (change_frame2_case g3 Hinvalid (symmetry Hdiff) g1) as [Hcase | Hcase].
* rewrite <- Hcase, <- Heq1. symmetry. now apply center_change_frame2.
* change ((change_frame2 config g0 â»Â¹) 0%VS) with (Similarity.center (change_frame2 config g0)).
@@ -1142,7 +1188,7 @@ do 2 destruct_match.
{ rewrite Hobs0. unfold observation0. rewrite map_add, map_singleton, add_In, In_singleton; autoclass. }
rewrite (change_frame2_obs g3 Hinvalid) in Hin. unfold observation0 in Hin.
rewrite map_add, map_singleton, add_In, In_singleton in Hin; autoclass; [].
- decompose [and or] Hin; trivial; elim Hdiff; []. now rewrite <- 2 center_change_frame2. }
+ decompose [and or] Hin; trivial; contradiction Hdiff; []. now rewrite <- 2 center_change_frame2. }
rewrite Hcase in Heq. fold sim0 sim1 in Heq. rewrite <- Heq in Habs.
apply Similarity.injective in Habs. contradiction.
+ assert (Heq1 : get_location (config (Good g1)) == (sim0 â»Â¹) one).
diff --git a/CaseStudies/Gathering/InR/Algorithm.v b/CaseStudies/Gathering/InR/Algorithm.v
index 34730f642cc01fee21b0f5dead44429b3b479261..7a439691ce3941aa29ce2399aa8894a712d758a4 100644
--- a/CaseStudies/Gathering/InR/Algorithm.v
+++ b/CaseStudies/Gathering/InR/Algorithm.v
@@ -18,7 +18,6 @@
(**************************************************************************)
Require Import Bool.
-Require Import Arith.Div2.
Require Import Lia.
Require Import Rbase Rbasic_fun.
Require Import List SetoidList.
@@ -26,17 +25,17 @@ Require Import RelationPairs.
Require Import Morphisms.
Require Import Psatz.
Require Import Inverse_Image.
-(* Pactole basic definitions *)
-Require Export Pactole.Setting.
Require Import FMapFacts.
(* Specific to R topology *)
Require Import Pactole.Spaces.R.
(* Specific to gathering *)
-Require Pactole.CaseStudies.Gathering.WithMultiplicity.
-(* I don't like this Import, but gathered_at is too frequent *)
-Require Import Pactole.CaseStudies.Gathering.Definitions.
+Require Import Pactole.CaseStudies.Gathering.WithMultiplicity.
+Require Import Pactole.Core.State.
(* Specific to multiplicity *)
Require Import Pactole.Observations.MultisetObservation.
+Require Import Pactole.Util.NumberComplements.
+(* I don't like this Import, but gathered_at is too frequent *)
+Require Import Pactole.CaseStudies.Gathering.Definitions.
Require Import Pactole.Models.Similarity.
(* Specific to rigidity *)
Require Export Pactole.Models.Rigid.
@@ -49,9 +48,11 @@ Import Datatypes.
Close Scope R_scope.
(* rule of thumb *)
-Typeclasses eauto := 10.
Set Implicit Arguments.
+(* this will become non default soon. *)
+Ltac Tauto.intuition_solver ::= auto with *.
+
(* Now we declare the context of our proof: things left abstract are
variables and hypothesis. Other things are defined by declaring type
class instances. *)
@@ -89,6 +90,8 @@ Instance InaFun : inactive_function unit := {
Instance Rigid : RigidSetting.
Proof using . split. reflexivity. Qed.
+Existing Instance multiset_observation.
+
(* Trying to avoid notation problem with implicit arguments *)
Notation "s [ x ]" := (multiplicity x s) (at level 2, no associativity, format "s [ x ]").
Notation obs_from_config := (@obs_from_config _ _ _ _ multiset_observation).
@@ -102,7 +105,8 @@ Arguments origin : simpl never.
Ltac changeR :=
change R with location in *;
change R_Setoid with location_Setoid in *;
- change R_EqDec with location_EqDec in *.
+ change R_EqDec with location_EqDec in *;
+ change SetoidDefs.R_EqDec with (@location_EqDec Loc) in *.
Lemma similarity_middle : forall (sim : similarity R) x y, (sim ((x + y) / 2) = (sim x + sim y) / 2)%R.
Proof using .
@@ -128,7 +132,7 @@ apply Permutation_nil. setoid_rewrite Permuted_sort at 2. rewrite Habs. reflexiv
Qed.
Lemma half_size_config : Nat.div2 nG > 0.
-Proof using size_G. assert (Heven := size_G). simpl. destruct n as [| [| ?]]; simpl; lia. Qed.
+Proof using size_G. assert (Heven := size_G). simpl. destruct n as [| [| ?]]; simpl; solve [ auto with arith | lia]. Qed.
(* We need to unfold [obs_is_ok] for rewriting *)
Definition obs_from_config_spec : forall config l,
@@ -179,9 +183,9 @@ intros config pt. split; intro Hmaj.
+ intro y. rewrite InA_singleton.
rewrite support_spec, max_spec1_iff; try (now apply obs_non_nil); [].
split; intro Hpt.
- - rewrite Hpt. intro x. destruct (Rdec x pt).
+ - rewrite Hpt. intro x. destruct (Req_dec_T x pt).
-- subst x. reflexivity.
- -- apply lt_le_weak. now apply (Hmaj x).
+ -- apply Nat.lt_le_incl. now apply (Hmaj x).
- destruct (Rdec y pt) as [? | Hy]; trivial.
exfalso. apply (Hmaj y) in Hy. specialize (Hpt pt). simpl in *. lia.
* intros x Hx. apply max_spec_lub.
@@ -191,32 +195,32 @@ Qed.
(** ** Some properties of [invalid] **)
-Lemma invalid_even : forall conf, WithMultiplicity.invalid conf -> Nat.Even nG.
+Lemma invalid_even : forall conf, (@WithMultiplicity.invalid Loc _ _ conf) -> Nat.Even nG.
Proof using . now intros conf [? _]. Qed.
Lemma invalid_support_length : forall config, WithMultiplicity.invalid config ->
size (!! config) = 2.
Proof using size_G.
intros config [Heven [_ [pt1 [pt2 [Hdiff [Hpt1 Hpt2]]]]]].
-rewrite <- (@cardinal_total_sub_eq _ _ _ _ _ (add pt2 (Nat.div2 nG) (singleton pt1 (Nat.div2 nG)))).
+rewrite <- (@cardinal_total_sub_eq _ _ _ _ _ (MMultisetInterface.add pt2 (Nat.div2 nG) (singleton pt1 (Nat.div2 nG)))).
* rewrite size_add; try (now apply half_size_config); [].
destruct (In_dec pt2 (singleton pt1 (Nat.div2 nG))) as [Hin | Hin].
+ exfalso. rewrite In_singleton in Hin.
- destruct Hin. now elim Hdiff.
+ destruct Hin. now contradiction Hdiff.
+ rewrite size_singleton; trivial. apply half_size_config.
-* intro pt. destruct (Rdec pt pt2), (Rdec pt pt1); subst.
- + now elim Hdiff.
+* intro pt. destruct (Req_dec_T pt pt2), (Req_dec_T pt pt1); subst.
+ + now contradiction Hdiff.
+ rewrite add_spec, singleton_spec.
setoid_rewrite Hpt2.
repeat destruct_match; simpl in *; contradiction || (try lia).
+ rewrite add_other, singleton_spec.
- - setoid_rewrite Hpt1. repeat destruct_match; simpl in *; contradiction || lia.
+ - changeR. setoid_rewrite Hpt1. repeat destruct_match; simpl in *; contradiction || lia.
- assumption.
+ rewrite add_other, singleton_spec.
- repeat destruct_match; simpl in *; contradiction || lia.
- assumption.
* rewrite cardinal_add, cardinal_singleton, cardinal_obs_from_config.
- simpl. rewrite plus_0_r. now apply even_div2.
+ simpl. rewrite Nat.add_0_r. now apply even_div2.
Qed.
Lemma support_max_1_not_invalid : forall config pt,
@@ -236,17 +240,17 @@ assert (Hsup : Permutation (support (!! config)) (pt1 :: pt2 :: nil)).
assert (Hin2 : InA equiv pt2 (support (!! config))).
{ rewrite support_spec. unfold In. setoid_rewrite Hpt2. apply half_size_config. }
apply (PermutationA_split _) in Hin1. destruct Hin1 as [l Hl]. rewrite Hl in Hin2.
- inversion_clear Hin2; try now subst; elim Hdiff.
+ inversion_clear Hin2; try now subst; contradiction Hdiff.
rewrite size_spec, Hl in Hsuplen. destruct l as [| x [| ? ?]]; simpl in Hsuplen; try lia.
inversion_clear H; (now inversion H0) || (cbn in H0; subst). now rewrite <- PermutationA_Leibniz. }
assert (Hpt : pt = pt1 \/ pt = pt2).
{ assert (Hin : List.In pt (pt1 :: pt2 :: nil)).
{ rewrite <- Hsup, <- InA_Leibniz. change eq with (@equiv location _).
+ changeR.
rewrite support_spec, <- max_subset, <- support_spec, Hmaj. now left. }
inversion_clear Hin; auto. inversion_clear H; auto. inversion H0. }
-apply (lt_irrefl (Nat.div2 nG)). destruct Hpt; subst pt.
-- rewrite <- Hpt1 at 2. rewrite <- Hpt2. apply max_spec_lub; try (now rewrite Hmax); [].
- rewrite Hmax. auto.
+apply (Nat.lt_irrefl (Nat.div2 nG)). destruct Hpt; subst pt.
+- rewrite <- Hpt1 at 2. rewrite <- Hpt2. apply max_spec_lub; try (now rewrite Hmax).
- rewrite <- Hpt1 at 1. rewrite <- Hpt2. apply max_spec_lub; now rewrite Hmax.
Qed.
@@ -289,7 +293,7 @@ Proof using size_G.
intro abs.
subst.
inversion hnodup;subst.
- elim H1.
+ contradiction H1.
constructor.
reflexivity.
* assert (h : inclA equiv (support (max (!! config))) (support (!! config))).
@@ -313,13 +317,13 @@ Proof using size_G.
rewrite Hsupp in hnodup.
inversion hnodup;subst.
match goal with
- | H: ~ InA equiv pt2 (pt2 :: nil) |- _ => elim H
+ | H: ~ InA equiv pt2 (pt2 :: nil) |- _ => contradiction H
end.
constructor 1.
reflexivity. }
assert (heq_config: equiv (!!config)
- (add pt1 ((!! config)[pt1])
- (add pt2 ((!! config)[pt2]) empty))).
+ (MMultisetInterface.add pt1 ((!! config)[pt1])
+ (MMultisetInterface.add pt2 ((!! config)[pt2]) empty))).
{ intros x.
destruct (equiv_dec x pt1) as [heqxpt1 | hneqxpt1].
- rewrite heqxpt1.
@@ -354,7 +358,7 @@ Proof using size_G.
- intros ? ? ? ? ? Heq; subst; now rewrite Heq.
- intros. lia.
- symmetry.
- transitivity ((pt1, (!! config)[pt1]) :: (elements (add pt2 (!! config)[pt2] empty))).
+ transitivity ((pt1, (!! config)[pt1]) :: (elements (MMultisetInterface.add pt2 (!! config)[pt2] empty))).
eapply elements_add_out;auto.
+ rewrite heq_config, add_same. cut ((!! config)[pt1] > 0). lia.
change (In pt1 (!! config)). rewrite <- support_spec, Hsupp. now left.
@@ -424,7 +428,7 @@ Lemma not_invalid_not_majority_length : forall config,
Proof using size_G.
intros config H1 H2.
assert (size (!! config) > 1)%nat.
-{ unfold gt. eapply lt_le_trans; try eassumption.
+{ unfold gt. eapply Nat.lt_le_trans; try eassumption.
f_equiv. apply max_subset. }
destruct (size (!! config)) as [| [| [| ?]]] eqn:Hlen; try lia.
exfalso. apply H2. now rewrite invalid_equiv.
@@ -480,10 +484,10 @@ destruct Hfmon as [Hfinc | Hfdec].
- rewrite map_last in Heq. apply Hfinj in Heq. contradiction.
- intro Habs. apply map_eq_nil in Habs. now apply (sort_non_nil config).
+ rewrite (hd_indep _ (f 0)) in Hneq.
- - elim Hneq. rewrite map_hd. now f_equal.
+ - contradiction Hneq. rewrite map_hd. hnf. now f_equal.
- intro Habs. apply map_eq_nil in Habs. now apply (sort_non_nil config).
+ rewrite (last_indep _ (f 0)) in Hneq0.
- - elim Hneq0. rewrite map_last. now f_equal.
+ - contradiction Hneq0. rewrite map_last. hnf. now f_equal.
- intro Habs. apply map_eq_nil in Habs. now apply (sort_non_nil config).
* repeat Rdec_full; trivial;
rewrite map_injective_support, (sort_map_decreasing Hfdec) in Heq
@@ -498,10 +502,10 @@ destruct Hfmon as [Hfinc | Hfdec].
- rewrite last_rev_hd, map_hd in Heq. apply Hfinj in Heq. contradiction.
- intro Habs. rewrite rev_nil in Habs. apply map_eq_nil in Habs. now apply (sort_non_nil config).
+ rewrite (last_indep _ (f 0)) in Hneq0.
- - elim Hneq0. rewrite last_rev_hd, map_hd. now f_equal.
+ - contradiction Hneq0. rewrite last_rev_hd, map_hd. hnf. now f_equal.
- intro Habs. rewrite rev_nil in Habs. apply map_eq_nil in Habs. now apply (sort_non_nil config).
+ rewrite (hd_indep _ (f 0)) in Hneq.
- - elim Hneq. rewrite hd_rev_last, map_last. now f_equal.
+ - contradiction Hneq. rewrite hd_rev_last, map_last. hnf. now f_equal.
- intro Habs. rewrite rev_nil in Habs. apply map_eq_nil in Habs. now apply (sort_non_nil config).
Qed.
@@ -519,7 +523,7 @@ Definition extreme_center (s : observation) := (mini s + maxi s) / 2.
Instance extreme_center_compat : Proper (equiv ==> eq) extreme_center.
Proof using . intros s s' Hs. unfold extreme_center, mini, maxi. now rewrite Hs. Qed.
-Lemma extreme_center_similarity : forall (sim : similarity location) s, s =/= empty ->
+Lemma extreme_center_similarity : forall (sim : (@similarity location (@state_Setoid Loc (@location Loc) Info) (@state_EqDec Loc (@location Loc) Info) _ _)) (s:multiset location), s =/= empty ->
extreme_center (map sim s) = sim (extreme_center s).
Proof using .
intros sim s Hs.
@@ -530,10 +534,10 @@ destruct (similarity_monotonic sim) as [Hinc | Hdec].
* rewrite map_injective_support, (sort_map_increasing Hinc); trivial; [].
assert (Hperm := Permuted_sort (support s)).
changeR. destruct (sort (support s)) as [| x l'].
- + symmetry in Hperm. apply Permutation_nil in Hperm. elim Hs. now rewrite <- support_nil.
+ + symmetry in Hperm. apply Permutation_nil in Hperm. contradiction Hs. now rewrite <- support_nil.
+ clear s Hs Hperm. simpl hd. cut (x :: l' <> nil). generalize (x :: l'). intro l.
generalize 0. induction l; intros r Hl.
- - now elim Hl.
+ - now contradiction Hl.
- simpl. destruct l.
simpl. symmetry. now apply similarity_middle.
rewrite <- IHl. reflexivity. discriminate.
@@ -542,10 +546,10 @@ destruct (similarity_monotonic sim) as [Hinc | Hdec].
rewrite last_rev_hd, hd_rev_last.
assert (Hperm := Permuted_sort (support s)).
changeR. destruct (sort (support s)) as [| x l'].
- + symmetry in Hperm. apply Permutation_nil in Hperm. elim Hs. now rewrite <- support_nil.
+ + symmetry in Hperm. apply Permutation_nil in Hperm. contradiction Hs. now rewrite <- support_nil.
+ clear s Hs Hperm. simpl hd. cut (x :: l' <> nil). generalize (x :: l'). intro l.
generalize 0. induction l; intros r Hl.
- - now elim Hl.
+ - now contradiction Hl.
- simpl. destruct l.
-- simpl. rewrite similarity_middle. now rewrite Rplus_comm.
-- rewrite <- IHl. reflexivity. discriminate.
@@ -596,7 +600,7 @@ Definition gatherR_pgm (s : observation) : location :=
| nil => 0 (* only happen with no robots *)
| pt :: nil => pt (* case 1: one majority stack *)
| _ => (* several majority stacks *)
- if beq_nat (size s) 3
+ if Nat.eqb (size s) 3
then middle s else
if is_extremal 0 s then 0 else extreme_center s
end.
@@ -633,7 +637,7 @@ Lemma round_simplify : forall config,
| nil => config id (* only happen with no robots *)
| pt :: nil => pt (* case 1: one majority stack *)
| _ => (* several majority stacks *)
- if beq_nat (size s) 3
+ if Nat.eqb (size s) 3
then middle s else
if is_extremal (config id) s then config id else extreme_center s
end
@@ -793,9 +797,10 @@ Theorem MajTower_at_forever : forall pt config,
MajTower_at pt config -> MajTower_at pt (round gatherR da config).
Proof using Hda size_G.
intros pt config Hmaj x Hx. assert (Hs := Hmaj x Hx).
-apply le_lt_trans with ((!! config)[x]); try eapply lt_le_trans; try eassumption; [|].
+apply Nat.le_lt_trans with ((!! config)[x]).
- eapply Majority_wither; eauto.
-- eapply Majority_grow; eauto.
+- apply Nat.lt_le_trans with (!! config)[pt]; try eassumption; [].
+ eapply Majority_grow; eauto.
Qed.
Theorem Majority_not_invalid : forall pt config, MajTower_at pt config -> ~WithMultiplicity.invalid config.
@@ -825,7 +830,7 @@ Lemma Generic_min_max_lt : forall config,
no_Majority config -> mini (!! config) < maxi (!! config).
Proof using size_G.
intros config Hmaj. apply Generic_min_max_lt_aux.
-+ apply lt_le_trans with (size (max (!! config))); trivial.
++ apply Nat.lt_le_trans with (size (max (!! config))); trivial.
rewrite <- size_spec. f_equiv. apply max_subset.
+ apply support_NoDupA.
Qed.
@@ -854,7 +859,7 @@ assert (Heq : config id == round gatherR da config id).
{ rewrite (round_simplify_Generic Hmaj Hlen id); trivial; [].
destruct (da.(activate) id); try reflexivity; [].
unfold is_extremal. Rdec_full; try reflexivity; [].
- elim Hneq. rewrite Hid. apply hd_indep. apply sort_non_nil. }
+ contradiction Hneq. }
(** Main proof *)
apply Rle_antisym.
* apply sort_min.
@@ -897,7 +902,7 @@ assert (Heq : config id == round gatherR da config id).
{ rewrite (round_simplify_Generic Hmaj Hlen id).
destruct (da.(activate) id); try reflexivity; [].
unfold is_extremal. repeat Rdec_full; try reflexivity; [].
- elim Hneq0. rewrite Hid. apply last_indep. apply sort_non_nil. }
+ contradiction Hneq0. }
(** Main proof *)
apply Rle_antisym.
* apply sort_max.
@@ -944,16 +949,24 @@ do 2 rewrite obs_from_config_spec, config_list_spec.
induction names as [| id l]; simpl in *; unfold Datatypes.id in *.
* reflexivity.
* changeR. destruct (activate da id).
- + destruct_match_eq Hext; repeat destruct_match.
+ + changeR. destruct_match_eq Hext;repeat destruct_match.
- f_equal. apply IHl.
- apply IHl.
- - elim (Rlt_irrefl (mini (!! config))).
+ - contradiction (Rlt_irrefl (mini (!! config))).
+ changeR.
match goal with H : extreme_center _ == _ |- _ => rewrite <- H at 2 end.
now apply Generic_min_mid_lt.
- - elim (Rlt_irrefl (mini (!! config))).
+ - contradiction (Rlt_irrefl (mini (!! config))).
match goal with H : extreme_center _ == _ |- _ => rewrite <- H at 2 end.
now apply Generic_min_mid_lt.
- - exfalso. revert Hext. unfold is_extremal. repeat destruct_match; tauto || discriminate.
+ - exfalso. revert Hext. unfold is_extremal.
+ match goal with
+ H: (config id == _) |- _ => rewrite H
+ end.
+ repeat destruct_match.
+ -- discriminate.
+ -- discriminate.
+ -- intros _. match goal with H: mini _ =/= mini _ |- _ => apply H end;auto.
- apply IHl.
+ destruct_match.
- f_equal. apply IHl.
@@ -975,13 +988,18 @@ induction names as [| id l]; simpl.
+ destruct_match_eq Hext; repeat destruct_match.
- f_equal. apply IHl.
- apply IHl.
- - elim (Rlt_irrefl (maxi (!! config))).
+ - contradiction (Rlt_irrefl (maxi (!! config))).
match goal with H : extreme_center _ == _ |- _ => rewrite <- H at 1 end.
now apply Generic_mid_max_lt.
- - elim (Rlt_irrefl (maxi (!! config))).
+ - contradiction (Rlt_irrefl (maxi (!! config))).
match goal with H : extreme_center _ == _ |- _ => rewrite <- H at 1 end.
now apply Generic_mid_max_lt.
- - exfalso. revert Hext. unfold is_extremal. repeat destruct_match; tauto || discriminate.
+ - exfalso. revert Hext. unfold is_extremal.
+ match goal with H: config id == _ |- _ => rewrite H end.
+ repeat destruct_match;intros ?.
+ -- discriminate.
+ -- discriminate.
+ -- match goal with H: maxi _ =/= maxi _ |- _ => apply H end;auto.
- apply IHl.
+ destruct_match.
- f_equal. apply IHl.
@@ -1017,7 +1035,7 @@ destruct (da.(activate) id1) eqn:Hmove1; [destruct (da.(activate) id2) eqn:Hmove
cbv zeta.
destruct (support (max (!! config))) as [| pt [| ? ?]] eqn:Hmaj.
+ (* no robots *)
- rewrite support_nil, max_is_empty in Hmaj. elim (obs_non_nil _ Hmaj).
+ rewrite support_nil, max_is_empty in Hmaj. contradiction (obs_non_nil _ Hmaj).
+ (* a majority tower *)
reflexivity.
+ destruct (size (!! config) =? 3) eqn:Hlen.
@@ -1052,7 +1070,7 @@ Proof using size_G.
intros config pt1 pt2 Hlen Hpt1 Hpt2 Hdiff12.
rewrite <- support_spec in Hpt1, Hpt2. rewrite size_spec in Hlen.
apply (PermutationA_split _) in Hpt1. destruct Hpt1 as [supp1 Hperm].
-rewrite Hperm in Hpt2. inversion_clear Hpt2; try (now elim Hdiff12); []. rename H into Hpt2.
+rewrite Hperm in Hpt2. inversion_clear Hpt2; try (now contradiction Hdiff12); []. rename H into Hpt2.
apply (PermutationA_split _) in Hpt2. destruct Hpt2 as [supp2 Hperm2].
rewrite Hperm2 in Hperm. rewrite Hperm in Hlen.
destruct supp2 as [| pt3 supp]; try (now simpl in Hlen; lia); [].
@@ -1084,7 +1102,7 @@ Proof using .
assert (Hg : forall id, get_location (round r da config id) <> pt \/ get_location (config id) = pt).
{ intro id. specialize (Hex id (In_names _)). revert Hex. repeat destruct_match; auto. }
(** We prove a contradiction by showing that the opposite inequality of Hlt holds. *)
- clear Hex. revert Hlt. apply le_not_lt.
+ clear Hex. revert Hlt. apply Nat.le_ngt.
do 2 rewrite obs_from_config_spec, config_list_spec.
induction names as [| id l]; simpl; trivial; [].
unfold Datatypes.id in *. repeat destruct_match; auto using le_n_S; [].
@@ -1103,6 +1121,9 @@ intros config pt. split.
assert (Hdest : forall id', List.In id' (moving gatherR da config) ->
get_location (round gatherR da config id') = pt).
{ intros. rewrite <- Hid. apply same_destination; trivial; rewrite moving_spec; auto. }
+ (* assert (Habs' : round gatherR da config id' =/= config id').
+ { intro Habs'. rewrite Habs' in Habs. now contradiction Habs. }
+ *)
assert (Hstay : forall id, get_location (config id) = pt -> get_location (round gatherR da config id) = pt).
{ intros id' Hid'. destruct (get_location (round gatherR da config id') =?= pt) as [Heq | Heq]; trivial; [].
assert (Habs := Heq). rewrite <- Hid' in Habs.
@@ -1115,13 +1136,13 @@ intros config pt. split.
inversion_clear Hin.
+ subst id'. clear IHl. simpl. hnf in Hroundid. unfold Datatypes.id.
destruct_match. revert_one @equiv. intro Heq.
- - rewrite <- Hid in Heq. elim Hroundid. now apply WithMultiplicity.no_info.
+ - rewrite <- Hid in Heq. contradiction Hroundid. changeR. now apply WithMultiplicity.no_info.
- destruct_match; try contradiction; []. apply le_n_S. induction l; simpl.
-- reflexivity.
-- repeat destruct_match; try now idtac + apply le_n_S + apply le_S; apply IHl.
- revert_one @complement. intro Hneq. elim Hneq. now apply Hstay.
+ revert_one @complement. intro Hneq. contradiction Hneq. now apply Hstay.
+ apply IHl in H. simpl in *. repeat destruct_match; try lia; [].
- revert_one @complement. intro Hneq. elim Hneq.
+ revert_one @complement. intro Hneq. contradiction Hneq.
apply Hdest. rewrite moving_spec. intro Habs. apply Hneq. now rewrite Habs.
Qed.
@@ -1160,7 +1181,7 @@ destruct (support (max (!! config))) as [| pt [| pt' l']] eqn:Hmaj.
{ assert (Hperm : Permutation (support (!! (round gatherR da config))) (pt1 :: pt2 :: nil)).
{ symmetry. apply NoDup_Permutation_bis.
+ repeat constructor.
- - intro Habs. inversion Habs. now elim Hdiff. now inversion H.
+ - intro Habs. inversion Habs. now contradiction Hdiff. now inversion H.
- intro Habs. now inversion Habs.
(* NoDupA_Leibniz had a useless hyp in coq stdlib until april 2020. *)
(* + rewrite <- NoDupA_Leibniz. change eq with (@equiv location _). apply support_NoDupA. *)
@@ -1183,7 +1204,7 @@ destruct (support (max (!! config))) as [| pt [| pt' l']] eqn:Hmaj.
{ intros id Hid.
rewrite <- Hrmove_pt.
apply same_destination; auto. rewrite moving_spec. congruence. }
- assert ((div2 nG) <= (!! config)[pt']).
+ assert ((Nat.div2 nG) <= (!! config)[pt']).
{ transitivity ((!! (round gatherR da config))[pt']).
- decompose [and or] Hpt; subst.
+ setoid_rewrite Hpt2. reflexivity.
@@ -1195,18 +1216,18 @@ destruct (support (max (!! config))) as [| pt [| pt' l']] eqn:Hmaj.
rewrite <- Hid1.
symmetry.
apply Hdest. rewrite moving_spec. assumption. }
- assert (Hlt : forall p, p <> pt' -> (!! config)[p] < div2 nG).
+ assert (Hlt : forall p, p <> pt' -> (!! config)[p] < Nat.div2 nG).
{ assert (Hpt'_in : In pt' (!! config)).
- { unfold In. eapply lt_le_trans; try eassumption. apply half_size_config. }
+ { unfold In. eapply Nat.lt_le_trans; try eassumption. apply half_size_config. }
assert (Hle := not_invalid_not_majority_length Hmaj Hok).
- intros p Hp. apply Nat.nle_gt. intro Habs. apply (lt_irrefl nG).
+ intros p Hp. apply Nat.nle_gt. intro Habs. apply (Nat.lt_irrefl nG).
destruct (@towers_elements_3 config pt' p Hle Hpt'_in) as [pt3' [Hdiff13 [Hdiff23 Hpt3_in]]]; trivial.
- + apply lt_le_trans with (div2 nG); try assumption. apply half_size_config.
+ + apply Nat.lt_le_trans with (Nat.div2 nG); try assumption. apply half_size_config.
+ auto.
- + eapply lt_le_trans; try apply (sum3_le_total config Hp Hdiff13 Hdiff23); [].
+ + eapply Nat.lt_le_trans; try apply (sum3_le_total config Hp Hdiff13 Hdiff23); [].
unfold In in Hpt3_in. rewrite <- (even_div2 _ HnG). lia. }
assert (Hmaj' : MajTower_at pt' config).
- { intros x Hx. apply lt_le_trans with (div2 nG); trivial. now apply Hlt. }
+ { intros x Hx. apply Nat.lt_le_trans with (Nat.div2 nG); trivial. now apply Hlt. }
apply MajTower_at_forever, Majority_not_invalid in Hmaj'. contradiction. }
Qed.
@@ -1219,7 +1240,7 @@ Definition config_to_NxN config :=
| nil => (0, 0)
| pt :: nil => (1, nG - s[pt])
| _ :: _ :: _ =>
- if beq_nat (size s) 3
+ if Nat.eqb (size s) 3
then (2, nG - s[nth 1 (sort (support s)) 0%R])
else (3, nG - (s[extreme_center s]
+ s[hd 0%R (sort (support s))]
@@ -1337,7 +1358,7 @@ assert (Hstep : da.(activate) gmove = true).
rewrite moving_spec in Hmove.
destruct (support (max (!! config))) as [| pt [| ? ?]] eqn:Hmaj.
* (* No robots *)
- elim (support_max_non_nil _ Hmaj).
+ contradiction (support_max_non_nil _ Hmaj).
* (* A majority tower *)
rewrite <- MajTower_at_equiv in Hmaj.
assert (Hmaj' : MajTower_at pt (round gatherR da config)) by now apply MajTower_at_forever.
@@ -1348,7 +1369,7 @@ destruct (support (max (!! config))) as [| pt [| ? ?]] eqn:Hmaj.
cut ((!! config)[pt] < (!! (round gatherR da config))[pt]). lia.
assert (Hdestg : get_location (round gatherR da config gmove) = pt).
{ rewrite (round_simplify_Majority Hmaj gmove).
- destruct (da.(activate) gmove); trivial; now elim Hstep. }
+ destruct (da.(activate) gmove); reflexivity || contradiction diff_false_true. }
rewrite increase_move_iff. eauto.
* rename Hmaj into Hmaj'.
assert (Hmaj : no_Majority config).
@@ -1364,7 +1385,7 @@ destruct (support (max (!! config))) as [| pt [| ? ?]] eqn:Hmaj.
assert (Hmaj' : no_Majority (round gatherR da config)).
{ unfold no_Majority. rewrite size_spec, Hmaj''. simpl. lia. } clear Hmaj''.
assert (Hlen' : size (!! (round gatherR da config)) = 3).
- { apply le_antisym.
+ { apply Nat.le_antisymm.
+ apply (support_decrease Hmaj Hlen).
+ apply (not_invalid_not_majority_length Hmaj'). now apply never_invalid. }
rewrite (config_to_NxN_Three_spec Hmaj' Hlen'). apply Lexprod.right_lex.
@@ -1383,7 +1404,7 @@ destruct (support (max (!! config))) as [| pt [| ? ?]] eqn:Hmaj.
unfold gt. rewrite increase_move_iff.
exists gmove. split; trivial; [].
rewrite (round_simplify_Three Hmaj Hlen gmove).
- destruct (da.(activate) gmove); reflexivity || now elim Hstep.
+ destruct (da.(activate) gmove); reflexivity || contradiction diff_false_true.
+ (* Generic case *)
red. rewrite (config_to_NxN_Generic_spec Hmaj Hlen).
destruct (support (max (!! (round gatherR da config)))) as [| pt' [| ? ?]] eqn:Hmaj'.
@@ -1412,9 +1433,9 @@ destruct (support (max (!! config))) as [| pt [| ? ?]] eqn:Hmaj.
lia.
rewrite increase_move_iff. exists gmove. split; trivial.
rewrite (round_simplify_Generic Hmaj Hlen gmove) in Hmove |- *; trivial; [].
- destruct (da.(activate) gmove); try (now elim Hstep); [].
+ destruct (da.(activate) gmove); [| contradiction diff_false_true].
destruct (is_extremal (config gmove) (!! config)).
- -- now elim Hmove.
+ -- now contradiction Hmove.
-- reflexivity.
Qed.
@@ -1451,8 +1472,9 @@ Lemma not_gathered_exists : forall config pt,
Proof using .
intros config pt Hgather.
destruct (forallb (fun x => if get_location (config x) =?= pt then true else false) names) eqn:Hall.
-- elim Hgather. rewrite forallb_forall in Hall.
- intro id'. setoid_rewrite Rdec_bool_true_iff in Hall. hnf. repeat rewrite Hall; trivial; apply In_names.
+- contradiction Hgather. rewrite forallb_forall in Hall.
+ intro id'. changeR.
+ setoid_rewrite Rdec_bool_true_iff in Hall. hnf. repeat rewrite Hall; trivial; apply In_names.
- rewrite <- negb_true_iff, existsb_forallb, existsb_exists in Hall.
destruct Hall as [id' [_ Hid']]. revert Hid'. destruct_match; discriminate || intro. now exists id'.
Qed.
@@ -1463,7 +1485,7 @@ Lemma not_invalid_gathered_Majority_size : forall config id,
Proof using size_G.
intros config id Hinvalid Hgather Hmaj.
assert (size (!! config) > 1).
-{ unfold no_Majority in Hmaj. eapply lt_le_trans; try eassumption; []. now rewrite max_subset. }
+{ unfold no_Majority in Hmaj. eapply Nat.lt_le_trans; try eassumption; []. now rewrite max_subset. }
rewrite invalid_equiv in Hinvalid.
destruct (size (!! config)) as [| [| [| ?]]]; lia || tauto.
Qed.
@@ -1474,7 +1496,7 @@ Theorem OneMustMove : forall config id, ~ WithMultiplicity.invalid config -> ~ga
Proof using size_G.
intros config id Hinvalid Hgather.
destruct (support (max (!! config))) as [| pt [| pt' l]] eqn:Hmaj.
-* elim (support_max_non_nil _ Hmaj).
+* contradiction (support_max_non_nil _ Hmaj).
* rewrite <- MajTower_at_equiv in Hmaj.
apply not_gathered_generalize with _ _ pt in Hgather.
apply not_gathered_exists in Hgather. destruct Hgather as [gmove Hmove].
@@ -1506,7 +1528,7 @@ destruct (support (max (!! config))) as [| pt [| pt' l]] eqn:Hmaj.
assert (Hnodup := support_NoDupA (!! config)).
rewrite NoDupA_Leibniz, Permuted_sort, Hsup in Hnodup.
inversion_clear Hnodup. inversion_clear H0. inversion_clear H2.
- destruct (Rdec pt2 (extreme_center (!! config))) as [Heq | Heq]; subst.
+ destruct (Rdec pt2 (extreme_center (!! config))) as [Heq | Heq]; simpl in Heq;subst.
- exists pt3. repeat split; try now intro; subst; intuition.
rewrite <- support_spec, InA_Leibniz, Permuted_sort, Hsup. intuition.
- exists pt2. repeat split; try now intro; subst; intuition.
@@ -1556,7 +1578,7 @@ intros da Hda config pt Hgather. rewrite (round_simplify_Majority).
induction names as [| id l].
+ reflexivity.
+ simpl. destruct_match.
- - elim Hdiff. simpl in *. subst. apply (no_byz id), Hgather.
+ - contradiction Hdiff. simpl in *. subst. apply (no_byz id), Hgather.
- apply IHl. }
rewrite H0. specialize (Hgather g1). rewrite <- Hgather. apply pos_in_config.
Qed.
diff --git a/CaseStudies/Gathering/InR/Impossibility.v b/CaseStudies/Gathering/InR/Impossibility.v
index 751914ecf63c85e67c42efff85a14e79d7f05682..a26c70346ae574dcd60a774d8e953f37df75024b 100644
--- a/CaseStudies/Gathering/InR/Impossibility.v
+++ b/CaseStudies/Gathering/InR/Impossibility.v
@@ -20,10 +20,10 @@
Require Import Reals.
Require Import Psatz.
Require Import Morphisms.
-Require Import Arith.Div2.
Require Import Lia.
Require Import List SetoidList.
-Require Import Pactole.Util.Preliminary.
+Require Import Pactole.Util.Preliminary Pactole.Util.Fin.
+Require Import Pactole.Util.Bijection.
Require Import Pactole.Setting.
Require Import FMapFacts.
Require Import Pactole.Spaces.R.
@@ -95,7 +95,7 @@ assert (Heven := even_nG). assert (H0 := nG_non_0).
simpl. destruct n as [| [| ?]].
- lia.
- destruct Heven. lia.
-- simpl. lia.
+- simpl. solve [ auto with arith | lia].
Qed.
(* We need to unfold [obs_is_ok] for rewriting *)
@@ -169,7 +169,7 @@ destruct (Nat.eq_dec (from_elements (List.map (fun x : location => (x, 1)) l))[e
change (InA eq_pair (e, (from_elements (List.map (fun x0 : R => (x0, 1)) l))[e])
(elements (from_elements (List.map (fun x : location => (x, 1)) l)))).
rewrite elements_spec; simpl.
- split; trivial; []. apply neq_0_lt. auto.
+ split; trivial; []. apply Nat.neq_0_lt_0. auto.
-- revert_all.
rewrite removeA_InA; autoclass. tauto.
Qed.
@@ -209,7 +209,7 @@ Hint Resolve half_size_config : core.
Definition lift_config {A} (config : G -> A) : ident -> A := fun id =>
match id with
| Good g => config g
- | Byz b => ltac:(exfalso; now apply (Nat.nlt_0_r (proj1_sig b)), proj2_sig)
+ | Byz b => ltac:(exfalso; now apply (Nat.nlt_0_r (fin2nat b)), fin_lt)
end.
Local Opaque G B.
@@ -308,7 +308,7 @@ assert (Heven : Nat.Even nG).
repeat split; trivial; [|].
+ rewrite <- Nat.even_spec in Heven.
assert (HnG := nG_non_0). simpl nG in *.
- destruct n as [| [| ?]]; simpl; discriminate || lia || now elim HnG.
+ destruct n as [| [| ?]]; simpl; discriminate || lia || now apply HnG.
+ exists (sim origin), (sim one).
repeat split.
- intro Heq. apply Similarity.injective in Heq. symmetry in Heq. revert Heq. apply non_trivial.
@@ -429,7 +429,7 @@ destruct (invalid_dec config) as [Hvalid | Hvalid].
{ decompose [and or] Hperm; unfold origin in *; simpl in *; congruence. }
simpl get_location. unfold id.
rewrite <- Hpt1. f_equiv. apply Hmove.
-* elim Hvalid.
+* contradiction Hvalid.
apply (invalid_reverse (build_similarity neq_0_1 Hdiff)).
rewrite Hobs. unfold observation0.
rewrite map_add, map_singleton, build_similarity_eq1, build_similarity_eq2; autoclass.
@@ -577,7 +577,7 @@ destruct (invalid_dec config) as [Hvalid | Hvalid].
repeat destruct_match; try contradiction; [|].
- simpl in *. destruct Hperm as [[] | []]; subst; auto.
- simpl in *. destruct Hperm as [[] | []]; subst; auto; congruence.
-+ elim Hvalid.
++ contradiction Hvalid.
apply (invalid_reverse (build_similarity neq_0_1 Hdiff)).
rewrite Hobs. unfold observation0.
rewrite map_add, map_singleton; autoclass; [].
@@ -719,7 +719,7 @@ destruct (get_location (config (Good g)) =?= get_location (config (Good g0))) as
- now rewrite build_similarity_eq1, Hsim0.
- rewrite build_similarity_eq2. rewrite Hobs in Hpt'. unfold observation0 in Hpt'.
rewrite map_add, map_singleton, add_In, In_singleton in Hpt'; autoclass; [].
- decompose [and or] Hpt'; auto; []. elim Hdiff'. etransitivity; eauto. }
+ decompose [and or] Hpt'; auto; []. contradiction Hdiff'. etransitivity; eauto. }
rewrite obs_from_config_ignore_snd, <- obs_from_config_map; autoclass; [].
rewrite Hobs, map_merge; autoclass; [].
rewrite <- (map_extensionality_compat Similarity.id), map_id; autoclass; [|].
@@ -735,11 +735,11 @@ destruct (get_location (config (Good g)) =?= get_location (config (Good g0))) as
{ assert (Hin := pos_in_config config origin (Good g)).
rewrite Hobs in Hin. unfold observation0 in Hin.
rewrite map_add, map_singleton, add_In, In_singleton in Hin; autoclass; [].
- destruct Hin as [[] | []]; trivial. elim Hcase. etransitivity; eauto. }
+ destruct Hin as [[] | []]; trivial. contradiction Hcase. etransitivity; eauto. }
destruct (select_tower_case_2 (fun pt1 pt2 (_ : pt1 =/= pt2) => true)
(fun pt1 pt2 (_ : pt1 =/= pt2) => false) true (Good g) Hvalid Hcase) as [Hdiff Hactivate].
rewrite Hactivate.
- destruct_match; trivial; []. elim Hcase. etransitivity; eauto.
+ destruct_match; trivial; []. contradiction Hcase. etransitivity; eauto.
Qed.
Lemma invalid_da2_left_next : forall config,
@@ -816,7 +816,7 @@ destruct (get_location (config (Good g)) =?= get_location (config (Good g0))) as
{ assert (Hin := pos_in_config config origin (Good g)).
rewrite Hobs in Hin. unfold observation0 in Hin.
rewrite map_add, map_singleton, add_In, In_singleton in Hin; autoclass; [].
- destruct Hin as [[] | []]; trivial; []. elim Hcase. etransitivity; eauto. }
+ destruct Hin as [[] | []]; trivial; []. contradiction Hcase. etransitivity; eauto. }
destruct (select_tower_case_2 (fun pt1 pt2 (_ : pt1 =/= pt2) => false)
(fun pt1 pt2 (_ : pt1 =/= pt2) => true) true (Good g) Hvalid Hcase) as [Hdiff Hactivate].
destruct (select_tower_case_2 (fun pt1 pt2 (Hdiff0 : pt1 =/= pt2) => build_similarity Hdiff0 neq_0_1)
@@ -831,7 +831,7 @@ destruct (get_location (config (Good g)) =?= get_location (config (Good g0))) as
rewrite Hobs, map_merge; autoclass; [].
rewrite <- (map_extensionality_compat Similarity.id), map_id; autoclass; [|].
+ destruct_match.
- - elim neq_0_1. apply (Similarity.injective sim).
+ - contradiction neq_0_1. apply (Similarity.injective sim).
now transitivity (get_location (config (Good g))).
- transitivity ((build_similarity (symmetry Hcase) neq_1_0)â»Â¹ move); try reflexivity; [].
rewrite Hsim, build_similarity_inverse.
@@ -870,7 +870,7 @@ assert (Hcase' : forall id, get_location (config id) = sim 0 \/ get_location (co
{ intro id. assert (Hin := pos_in_config config origin id). unfold observation0 in *.
rewrite Hobs', map_add, map_singleton, add_In, In_singleton in Hin; autoclass; simpl in *; tauto. }
assert (Hsim1 : get_location (config (Good g0)) == sim 1).
-{ destruct (Hcase' (Good g0)); trivial; []. elim Hg3. now rewrite <- Hsim0. }
+{ destruct (Hcase' (Good g0)); trivial; []. contradiction Hg3. now rewrite <- Hsim0. }
clear pt1 pt2 g1 g2 Hg1 Hg2 Hdiff Hobs Hcase.
assert (Hdiff_move : sim move =/= sim 1).
{ intro Heq. now apply Similarity.injective in Heq. }
@@ -928,7 +928,7 @@ assert (Hcase' : forall id, get_location (config id) = sim 0 \/ get_location (co
{ intro id. assert (Hin := pos_in_config config origin id). unfold observation0 in *.
rewrite Hobs', map_add, map_singleton, add_In, In_singleton in Hin; autoclass; simpl in *; tauto. }
assert (Hsim1 : get_location (config (Good g0)) == sim 1).
-{ destruct (Hcase' (Good g0)); trivial; []. elim Hg3. now rewrite <- Hsim0. }
+{ destruct (Hcase' (Good g0)); trivial; []. contradiction Hg3. now rewrite <- Hsim0. }
clear pt1 pt2 g1' g2' Hg1 Hg2 Hdiff Hobs Hcase.
erewrite 2 round_simplify2_right; auto; [].
rewrite 2 mk_info_get_location.
diff --git a/CaseStudies/Gathering/InR2/Algorithm.v b/CaseStudies/Gathering/InR2/Algorithm.v
index 19e3bb59a59852899a1c82bf783488ce7854440b..0840d36cd4d784aad3a19b4b6f362af7f2cbdfe4 100644
--- a/CaseStudies/Gathering/InR2/Algorithm.v
+++ b/CaseStudies/Gathering/InR2/Algorithm.v
@@ -19,7 +19,6 @@
Require Import Bool.
-Require Import Arith.Div2.
Require Import Lia Field Lra.
Require Import Rbase Rbasic_fun R_sqrt Rtrigo_def.
Require Import List.
@@ -37,7 +36,7 @@ Require Export Pactole.Setting.
(* Specific to R^2 topology *)
Require Import Pactole.Spaces.R2.
(* Specific to gathering *)
-Require Pactole.CaseStudies.Gathering.WithMultiplicity.
+Require Import Pactole.CaseStudies.Gathering.WithMultiplicity.
Require Import Pactole.CaseStudies.Gathering.Definitions.
(* Specific to multiplicity *)
Require Import Pactole.Observations.MultisetObservation.
@@ -55,6 +54,8 @@ Set Implicit Arguments.
Close Scope R_scope.
Close Scope VectorSpace_scope.
+(* this will become non default soon. *)
+Ltac Tauto.intuition_solver ::= auto with *.
(** * The Gathering Problem **)
@@ -117,7 +118,7 @@ Ltac changeR2 :=
Lemma config_list_alls : forall pt, config_list (fun _ => pt) = alls pt nG.
Proof using .
intro. rewrite config_list_spec, map_cst.
-rewrite names_length. simpl. now rewrite plus_0_r.
+rewrite names_length. simpl. now rewrite Nat.add_0_r.
Qed.
Lemma no_byz_eq : forall config1 config2 : configuration,
@@ -233,9 +234,9 @@ intros ? ? Heq. unfold is_clean.
destruct (inclA_bool _ equiv_dec (support x) (SECT x)) eqn:Hx,
(inclA_bool _ equiv_dec (support y) (SECT y)) eqn:Hy;
trivial; rewrite ?inclA_bool_true_iff, ?inclA_bool_false_iff in *; [|].
-+ elim Hy. intros e Hin. rewrite <- Heq in Hin.
++ contradiction Hy. intros e Hin. rewrite <- Heq in Hin.
apply SECT_compat in Heq. rewrite <- Heq. now apply Hx.
-+ elim Hx. intros e Hin. rewrite Heq in Hin.
++ contradiction Hx. intros e Hin. rewrite Heq in Hin.
apply SECT_compat in Heq. rewrite Heq. now apply Hy.
Qed.
@@ -349,10 +350,10 @@ intros config pt. split; intro Hmaj.
simpl equiv. split; intro Hpt.
- subst y. intro x. destruct (equiv_dec x pt).
-- rewrite e. reflexivity.
- -- apply lt_le_weak. now apply (Hmaj x).
+ -- apply Nat.lt_le_incl. now apply (Hmaj x).
- destruct (equiv_dec y pt) as [? | Hy]; trivial.
- exfalso. apply (Hmaj y) in Hy. elim (lt_irrefl (!! config)[pt]).
- eapply le_lt_trans; try eassumption; [].
+ exfalso. apply (Hmaj y) in Hy. contradiction (Nat.lt_irrefl (!! config)[pt]).
+ eapply Nat.le_lt_trans; try eassumption; [].
apply Hpt.
* intros x Hx. apply max_spec_lub.
- rewrite <- support_spec, Hmaj. now left.
@@ -442,7 +443,7 @@ assert (Hsup : Permutation (support (!! config)) ([pt1; pt2])).
assert (Hin2 : InA equiv pt2 (support (!! config))).
{ rewrite support_spec. unfold In. changeR2. setoid_rewrite Hpt2. now apply Exp_prop.div2_not_R0. }
apply (PermutationA_split _) in Hin1. destruct Hin1 as [l Hl]. rewrite Hl in Hin2.
- inversion_clear Hin2; try now subst; elim Hdiff.
+ inversion_clear Hin2; try now subst; contradiction Hdiff.
rewrite size_spec, Hl in Hsuplen. destruct l as [| x [| ? ?]]; simpl in Hsuplen; try lia.
inversion_clear H.
- inversion H0; simpl in H1; subst.
@@ -460,9 +461,8 @@ assert (Hpt : pt = pt1 \/ pt = pt2).
setoid_rewrite Hmaj.
now left. }
inversion_clear Hin; auto. inversion_clear H0; auto. inversion H1. }
-apply (lt_irrefl (Nat.div2 nG)). destruct Hpt; subst pt.
+apply (Nat.lt_irrefl (Nat.div2 nG)). destruct Hpt; subst pt.
- rewrite <- Hpt1 at 2. rewrite <- Hpt2. apply max_spec_lub; try now rewrite Hmax.
- rewrite Hmax. auto.
- rewrite <- Hpt1 at 1. rewrite <- Hpt2. apply max_spec_lub; now rewrite Hmax.
Qed.
@@ -503,7 +503,7 @@ intro config. unfold no_Majority. split.
intro abs.
subst.
inversion hnodup; subst.
- elim H1.
+ contradiction H1.
constructor.
reflexivity.
* assert (h : inclA equiv (support (max (!! config))) (support (!! config))).
@@ -525,7 +525,7 @@ intro config. unfold no_Majority. split.
assert (hnodup := support_NoDupA (!! config)).
rewrite Hsupp in hnodup.
inversion hnodup; subst.
- match goal with H : ~ InA equiv pt2 ([pt2]) |- _ => elim H end.
+ match goal with H : ~ InA equiv pt2 (pt2 :: nil) |- _ => contradiction H end.
constructor 1.
reflexivity. }
assert (heq_config: !! config == Madd pt1 ((!! config)[pt1]) (Madd pt2 ((!! config)[pt2]) empty)).
@@ -631,7 +631,7 @@ Lemma not_invalid_no_majority_size : forall config,
Proof using size_G.
intros config H1 H2.
assert (size (!! config) > 1)%nat.
-{ unfold gt. eapply lt_le_trans; try eassumption; []. f_equiv. apply max_subset. }
+{ unfold gt. eapply Nat.lt_le_trans; try eassumption; []. f_equiv. apply max_subset. }
destruct (size (!! config)) as [| [| [| ?]]] eqn:Hlen; try lia.
exfalso. apply H2. now rewrite invalid_equiv.
Qed.
@@ -670,7 +670,7 @@ Qed.
Lemma SECT_cardinal_le_nG : forall config, SECT_cardinal (!! config) <= nG.
Proof using .
intro config. unfold SECT_cardinal.
-replace nG with (nG + nB) by (simpl; apply plus_0_r).
+replace nG with (nG + nB) by (simpl; apply Nat.add_0_r).
rewrite <- (cardinal_obs_from_config config origin).
apply cardinal_sub_compat, filter_subset.
intros ? ? H. now rewrite H.
@@ -810,10 +810,10 @@ intros sim s s_nonempty. unfold is_clean. changeR2.
destruct (inclA_bool _ equiv_dec (support (map sim s)) (SECT (map sim s))) eqn:Hx,
(inclA_bool _ equiv_dec (support s) (SECT s)) eqn:Hy;
trivial; rewrite ?inclA_bool_true_iff, ?inclA_bool_false_iff, ?inclA_Leibniz in *; [|].
-- elim Hy. intros x Hin. apply (in_map sim) in Hin. rewrite <- map_sim_support in Hin.
+- contradiction Hy. intros x Hin. apply (in_map sim) in Hin. rewrite <- map_sim_support in Hin.
apply Hx in Hin. rewrite SECT_morph, in_map_iff in Hin;auto.
destruct Hin as [x' [Heq ?]]. apply (Similarity.injective sim) in Heq. now rewrite <- Heq.
-- elim Hx. intros x Hin. rewrite SECT_morph; auto. rewrite map_sim_support in Hin.
+- contradiction Hx. intros x Hin. rewrite SECT_morph; auto. rewrite map_sim_support in Hin.
rewrite in_map_iff in *. destruct Hin as [x' [? Hin]]. subst. exists x'. repeat split. now apply Hy.
Qed.
@@ -1095,7 +1095,7 @@ destruct (support (max (!! config))) as [| pt1 [| pt2 l]] eqn:Hmax,
(support (max (!! (map_config sim config)))) as [| pt1' [| pt2' l']];
simpl in Hlen; discriminate || clear Hlen; [| |].
* (* No maximal tower *)
- rewrite support_nil, max_is_empty in Hmax. elim (obs_non_nil _ Hmax).
+ rewrite support_nil, max_is_empty in Hmax. contradiction (obs_non_nil _ Hmax).
* (* One maximal tower *)
simpl in Hperm. rewrite <- PermutationA_Leibniz, (PermutationA_1 _) in Hperm.
subst pt1'. apply Bijection.retraction_section.
@@ -1188,7 +1188,7 @@ destruct (da.(activate) id) eqn:Hactive.
destruct (is_clean (!! config)) eqn:Hclean.
+ reflexivity.
+ destruct (mem equiv_dec (get_location (config id)) (SECT (!! config))) eqn:Hmem.
- - now elim Hmove.
+ - now contradiction Hmove.
- reflexivity.
* apply moving_active in Hmove; trivial; []. rewrite active_spec in Hmove. congruence.
Qed.
@@ -1203,10 +1203,10 @@ destruct (le_lt_dec 2 (length (support (max (!! config))))) as [Hle |Hlt].
now repeat rewrite destination_is_target.
+ rewrite moving_spec in Hmove1, Hmove2.
rewrite (round_simplify _ id1) in Hmove1 |- *. rewrite (round_simplify _ id2) in Hmove2 |- *.
- destruct (da.(activate) id1), (da.(activate) id2); try (now elim Hmove1 + elim Hmove2); [].
+ destruct (da.(activate) id1), (da.(activate) id2); try (now contradiction Hmove1 + contradiction Hmove2); [].
cbn zeta in *.
destruct (support (max (!! config))) as [| ? [| ? ?]] eqn:Hsupp.
- - now elim Hmove1.
+ - now contradiction Hmove1.
- reflexivity.
- simpl in Hlt. lia.
Qed.
@@ -1233,7 +1233,7 @@ destruct (existsb (fun x => if get_location (round r da config x) =?= pt then
assert (Hg : forall id, get_location (round r da config id) <> pt \/ get_location (config id) = pt).
{ intro id. specialize (Hex id (In_names _)). revert Hex. repeat destruct_match; try discriminate; auto. }
(** We prove a contradiction by showing that the opposite inequality of Hlt holds. *)
- clear Hex. revert Hlt. apply le_not_lt.
+ clear Hex. revert Hlt. apply Nat.le_ngt.
setoid_rewrite WithMultiplicity.obs_from_config_spec.
do 2 rewrite config_list_spec.
induction names as [| id l]; trivial; [].
@@ -1266,14 +1266,14 @@ intros config pt. split.
induction names as [| id' l]; try (now inversion Hin); [].
inversion_clear Hin.
+ subst id'. clear IHl. simpl. R2dec_full.
- - rewrite <- Hid in Heq. now elim Hroundid.
+ - rewrite <- Hid in Heq. now contradiction Hroundid.
- R2dec_full; try contradiction; [].
apply le_n_S. induction l as [| id' ?]; simpl.
-- reflexivity.
-- repeat R2dec_full; try now idtac + apply le_n_S + apply le_S; apply IHl.
exfalso. now generalize (Hstay id' ltac:(assumption)).
+ apply IHl in H. simpl. repeat R2dec_full; try (simpl in *; lia); [].
- elim Hneq. apply Hdest. rewrite moving_spec. intro Habs. rewrite Habs in Hneq. contradiction.
+ contradiction Hneq. apply Hdest. rewrite moving_spec. intro Habs. rewrite Habs in Hneq. contradiction.
Qed.
(** *** Generic results about the [SEC] after one round **)
@@ -1299,7 +1299,7 @@ destruct (@increase_move gatherR2 config x) as [r_moving [Hdest_rmoving Hrmoving
* simpl in *. lia.
* destruct (le_lt_dec 2 (length (support (max (!! config))))) as [Hle | Hlt].
+ rewrite destination_is_target in Hdest_rmoving.
- - now elim Heq.
+ - now contradiction Heq.
- unfold no_Majority. now rewrite size_spec.
- rewrite moving_spec. intro Habs. apply Hrmoving. now rewrite Habs.
+ assert ((support (max (!! config))) = [x]).
@@ -1371,7 +1371,7 @@ intros config id Hmaj Hclean Hcircle.
rewrite (round_simplify_dirty Hmaj Hclean id).
destruct (da.(activate) id); try reflexivity; [].
destruct (mem equiv_dec (get_location (config id)) (SECT (!! config))) eqn:Hmem; try reflexivity; [].
-rewrite mem_false_iff in Hmem. elim Hmem.
+rewrite mem_false_iff in Hmem. contradiction Hmem.
unfold SECT. right. unfold on_SEC. rewrite filter_InA; autoclass; [].
split; trivial; [].
rewrite support_spec. apply pos_in_config.
@@ -1469,7 +1469,7 @@ Theorem MajTower_at_forever : forall pt config,
MajTower_at pt config -> MajTower_at pt (round gatherR2 da config).
Proof using Hssync.
intros pt config Hmaj x Hx. assert (Hs := Hmaj x Hx).
-apply le_lt_trans with ((!! config)[x]); try eapply lt_le_trans; try eassumption; [|].
+apply Nat.le_lt_trans with ((!! config)[x]); try eapply Nat.lt_le_trans; try eassumption; [|].
- eapply Majority_wither; eauto.
- eapply Majority_grow; eauto.
Qed.
@@ -1525,8 +1525,8 @@ assert (Hext : forall x, f (!! (round gatherR2 da config)) x = f (!! config) x).
{ intro pt. unfold f.
destruct (InA_dec equiv_dec pt (SECT (!! config))) as [Htest1 | Htest1],
(InA_dec equiv_dec pt (SECT (!! (round gatherR2 da config)))) as [Htest2 | Htest2]; trivial.
- - elim Htest2. now rewrite HsameSECT.
- - elim Htest1. now rewrite <- HsameSECT. }
+ - contradiction Htest2. now rewrite HsameSECT.
+ - contradiction Htest1. now rewrite <- HsameSECT. }
unfold f in Hext.
rewrite (filter_extensionality_compat _ _ Hext). clear Hext.
pose (f_target := fun x => if equiv_dec x (target (!! config)) then true else false).
@@ -1571,7 +1571,7 @@ assert (Heq : equiv (filter f_out_target (!! (round gatherR2 da config)))
unfold f_target in Htest.
revert Htest. destruct_match; try discriminate; auto.
-- apply IHl.
- - destruct_match; (now elim Hneq) || apply IHl. }
+ - destruct_match; (now contradiction Hneq) || apply IHl. }
rewrite Heq.
lia.
Qed.
@@ -1587,7 +1587,7 @@ Proof using size_G.
intros config pt1 pt2 Hlen Hpt1 Hpt2 Hdiff12.
rewrite <- support_spec in Hpt1, Hpt2. rewrite size_spec in Hlen.
apply (PermutationA_split _) in Hpt1. destruct Hpt1 as [supp1 Hperm].
-rewrite Hperm in Hpt2. inversion_clear Hpt2; try (now elim Hdiff12); []. rename H into Hpt2.
+rewrite Hperm in Hpt2. inversion_clear Hpt2; try (now contradiction Hdiff12); []. rename H into Hpt2.
apply (PermutationA_split _) in Hpt2. destruct Hpt2 as [supp2 Hperm2].
rewrite Hperm2 in Hperm. rewrite Hperm in Hlen.
destruct supp2 as [| pt3 supp]; try (now simpl in Hlen; lia); [].
@@ -1654,7 +1654,7 @@ destruct (support (max (!! config))) as [| pt [| pt' l']] eqn:Hmaj.
{ assert (Hperm : Permutation (support (!! (round gatherR2 da config))) ([pt1; pt2])).
{ symmetry. apply NoDup_Permutation_bis.
+ repeat constructor.
- - intro Habs. inversion Habs. now elim Hdiff. now inversion H.
+ - intro Habs. inversion Habs. now contradiction Hdiff. now inversion H.
- intro Habs. now inversion Habs.
+ rewrite <- size_spec.
now setoid_rewrite <- WithMultiplicity.invalid_size.
@@ -1674,7 +1674,7 @@ destruct (support (max (!! config))) as [| pt [| pt' l']] eqn:Hmaj.
assert (Hdest : forall g, List.In g (moving gatherR2 da config) ->
get_location (round gatherR2 da config g) == pt).
{ intros id Hid. rewrite <- Hrmove_pt. apply same_destination; auto. rewrite moving_spec. congruence. }
- assert ((div2 nG) <= (!! config)[pt']).
+ assert ((Nat.div2 nG) <= (!! config)[pt']).
{ transitivity ((!! (round gatherR2 da config))[pt']).
- decompose [and or] Hpt; clear Hpt; subst.
+ setoid_rewrite Hpt2. simpl. reflexivity.
@@ -1686,19 +1686,21 @@ destruct (support (max (!! config))) as [| pt [| pt' l']] eqn:Hmaj.
rewrite <- Hid1.
symmetry.
apply Hdest. rewrite moving_spec. intro Habs. apply Hid2. now rewrite Habs. }
- assert (Hlt : forall p, p <> pt' -> (!! config)[p] < div2 nG).
+ assert (Hlt : forall p, p <> pt' -> (!! config)[p] < Nat.div2 nG).
{ assert (Hpt'_in : In pt' (!! config)).
- { unfold In. eapply lt_le_trans; try eassumption. apply Exp_prop.div2_not_R0. apply HsizeG. }
+ { unfold In. eapply Nat.lt_le_trans; try eassumption. apply Exp_prop.div2_not_R0. apply HsizeG. }
assert (Hle := not_invalid_no_majority_size Hmaj Hok).
- intros p Hp. apply Nat.nle_gt. intro Habs. apply (lt_irrefl nG).
+ intros p Hp. apply Nat.nle_gt. intro Habs. apply (Nat.lt_irrefl nG).
destruct (@towers_elements_3 config pt' p Hle Hpt'_in) as [pt3' [Hdiff13 [Hdiff23 Hpt3_in]]]; trivial.
- + apply lt_le_trans with (div2 nG); try assumption. apply Exp_prop.div2_not_R0. apply HsizeG.
+ + apply Nat.lt_le_trans with (Nat.div2 nG); try assumption. apply Exp_prop.div2_not_R0. apply HsizeG.
+ auto.
- + eapply lt_le_trans; try apply (sum3_le_total config Hp Hdiff13 Hdiff23); [].
- unfold In in Hpt3_in. rewrite <- ?Even.even_equiv in *.
- rewrite (even_double nG); auto. unfold Nat.double. lia. }
+ + eapply Nat.lt_le_trans; try apply (sum3_le_total config Hp Hdiff13 Hdiff23); [].
+ unfold In in Hpt3_in. rewrite <- ?Nat.Even_alt_Even in *.
+ rewrite (Nat.Even_double nG).
+ 2:{ now apply Nat.Even_alt_Even. }
+ unfold Nat.double. lia. }
assert (Hmaj' : MajTower_at pt' config).
- { intros x Hx. apply lt_le_trans with (div2 nG); trivial. now apply Hlt. }
+ { intros x Hx. apply Nat.lt_le_trans with (Nat.div2 nG); trivial. now apply Hlt. }
apply MajTower_at_equiv in Hmaj'.
red in Hmaj.
rewrite size_spec in Hmaj.
@@ -1809,7 +1811,7 @@ intros config ptx pty Hinvalid Hmaj Hclean Hsec.
assert (Hperm := diameter_clean_support Hinvalid Hmaj Hclean Hsec).
destruct (support (max (!! (round gatherR2 da config)))) as [| pt [| ? ?]] eqn:Hmax'.
- rewrite support_nil, max_is_empty, <- support_nil in Hmax'.
- now elim (support_non_nil _ Hmax').
+ now contradiction (support_non_nil _ Hmax').
- left. exists pt.
rewrite MajTower_at_equiv. now rewrite Hmax'.
- right.
@@ -2005,7 +2007,7 @@ Lemma triangle_next_maj_or_diameter_or_triangle : forall config,
Proof using Hssync da n size_G.
intros config Hinvalid [Hmaj [ptx [pty [ptz Hsec]]]].
destruct (support (max (!! (round gatherR2 da config)))) as [| pt1 [| pt2 l]] eqn:Hmax'.
-- rewrite support_nil, max_is_empty in Hmax'. elim (obs_non_nil _ Hmax').
+- rewrite support_nil, max_is_empty in Hmax'. contradiction (obs_non_nil _ Hmax').
- now left.
- right.
get_case (round gatherR2 da config). rename Hmaj0 into Hmaj'.
@@ -2486,7 +2488,7 @@ destruct (support (max (!! (round gatherR2 da config)))) as [| pt1 [| pt2 l]] eq
++ assert (Hperm' : PermutationA equiv (support (!! (round gatherR2 da config)))
(isobarycenter ([ptx; pty; ptz]) :: [ptx; pty; ptz])).
{ assert ((!! (round gatherR2 da config))[target (!! config)] > 0).
- { apply le_lt_trans with ((!! config)[target (!! config)]); try lia.
+ { apply Nat.le_lt_trans with ((!! config)[target (!! config)]); try lia.
rewrite increase_move_iff.
exists gmove. split.
- apply destination_is_target; trivial.
@@ -2801,8 +2803,8 @@ assert (Hex : forall id id',
{ intros id id' Hid Hid' Hneq Hactive. simpl in *.
destruct (da.(activate) id') eqn:Hactive'; trivial; exfalso.
decompose [or] Hid; decompose [or] Hid'; try subst id; try subst id';
- (now elim Hneq) || rewrite Hactive in *; changeR2; rewrite Hactive' in *;
- rewrite ?Hid1, ?Hid2, ?Hid3, ?Hid4 in *; cbn in *; congruence. }
+ (now contradiction Hneq) || rewrite Hactive in *; changeR2; rewrite Hactive' in *;
+ rewrite ?Hid1, ?Hid2, ?Hid3, ?Hid4 in *; R2dec. }
(* Therefore, at least three were not activated and not on the target *)
assert (Hperm_id : exists id1' id2' id3' id4',
Permutation ([id1; id2; id3; id4]) ([id1'; id2'; id3'; id4'])
@@ -2931,7 +2933,7 @@ Proof using Hssync.
unfold measure at 2.
destruct (support (max (!! config))) as [| pt [| pt' smax]] eqn:Hmax.
- (* No robots *)
- rewrite support_nil, max_is_empty in Hmax. elim (obs_non_nil _ Hmax).
+ rewrite support_nil, max_is_empty in Hmax. contradiction (obs_non_nil _ Hmax).
- (* A majority tower *)
get_case config.
apply MajTower_at_forever in Hcase.
@@ -2949,7 +2951,7 @@ Proof using Hssync.
simpl.
get_case config.
rewrite (round_simplify_Majority Hcase0 gmove).
- destruct (da.(activate) gmove); try reflexivity; []. now elim Hactive.
+ destruct (da.(activate) gmove); try reflexivity; []. contradiction diff_false_true.
- (* Computing the SEC *)
get_case config. clear Hmax pt pt' smax.
destruct (is_clean (!! config)) eqn:Hclean.
@@ -3042,7 +3044,7 @@ Proof using Hssync.
unfold measure.
destruct (support (max (!! (round gatherR2 da config)))) as [| ? [| ? ?]] eqn:Hmax'.
* (* Absurd: no robot after one round *)
- rewrite support_nil, max_is_empty in Hmax'. elim (obs_non_nil _ Hmax').
+ rewrite support_nil, max_is_empty in Hmax'. contradiction (obs_non_nil _ Hmax').
* (* A majority tower after one round *)
destruct (on_SEC (support (!! config))) as [| ? [| ? [| ? [| ? ?]]]];
cbn in Hle; lia || left; lia.
@@ -3062,7 +3064,7 @@ End SSYNC_Results.
(* destination is independent from the demonic_action. This replace
the same_destination inside previous section. *)
Corollary same_destination_strong : forall da da' (config : configuration) id1 id2,
- SSYNC_da da -> SSYNC_da da' ->
+ SSYNC_da da -> SSYNC_da da' ->
List.In id1 (moving gatherR2 da config) ->
List.In id2 (moving gatherR2 da' config) ->
round gatherR2 da config id1 == round gatherR2 da' config id2.
@@ -3076,10 +3078,10 @@ Proof using Type.
rewrite (round_simplify da hss _ id1) in Hmove1 |- *.
rewrite (round_simplify da' hss' _ id2) in Hmove2 |- *.
destruct (da.(activate) id1), (da'.(activate) id2);
- try (now elim Hmove1 + elim Hmove2); [].
+ try (now contradiction Hmove1 + contradiction Hmove2); [].
cbn zeta in *.
destruct (support (max (!! config))) as [| ? [| ? ?]] eqn:Hsupp.
- - now elim Hmove1.
+ - now contradiction Hmove1.
- reflexivity.
- simpl in Hlt. lia.
Qed.
@@ -3104,7 +3106,7 @@ Lemma not_gathered_exists : forall config pt,
Proof using .
intros config pt Hgather.
destruct (forallb (fun x => if get_location (config x) =?= pt then true else false) names) eqn:Hall.
-- elim Hgather. rewrite forallb_forall in Hall.
+- contradiction Hgather. rewrite forallb_forall in Hall.
intro id'. setoid_rewrite R2dec_bool_true_iff in Hall. repeat rewrite Hall; reflexivity || apply In_names.
- rewrite <- negb_true_iff, existsb_forallb, existsb_exists in Hall.
destruct Hall as [id' [_ Hid']]. revert Hid'. destruct_match; discriminate || now exists id'.
@@ -3116,7 +3118,7 @@ Theorem OneMustMove : forall config id, ~ WithMultiplicity.invalid config -> ~ga
Proof using .
intros config id Hvalid Hgather.
destruct (support (max (!! config))) as [| pt [| pt' lmax]] eqn:Hmax.
-* elim (support_max_non_nil _ Hmax).
+* contradiction (support_max_non_nil _ Hmax).
* rewrite <- MajTower_at_equiv in Hmax.
apply not_gathered_generalize with _ _ pt in Hgather.
apply not_gathered_exists in Hgather. destruct Hgather as [gmove Hmove].
@@ -3124,7 +3126,7 @@ destruct (support (max (!! config))) as [| pt [| pt' lmax]] eqn:Hmax.
rewrite (round_simplify_Majority _ Hda Hmax gmove).
destruct_match.
+ intro Habs. apply Hmove. now rewrite <- Habs.
- + now elim Hactive.
+ + contradiction diff_false_true.
* (* No majority tower *)
get_case config.
destruct (is_clean (!! config)) eqn:Hclean.
@@ -3143,7 +3145,7 @@ destruct (support (max (!! config))) as [| pt [| pt' lmax]] eqn:Hmax.
destruct Hin as [gmove Hmove].
exists gmove. intros da Hda Hactive. rewrite active_spec in Hactive. rewrite moving_spec.
rewrite (round_simplify_dirty da Hda Hmaj Hclean gmove).
- destruct (da.(activate) gmove); try (now elim Hactive); [].
+ destruct (da.(activate) gmove); [|contradiction diff_false_true].
destruct (mem equiv_dec (get_location (config gmove)) (SECT (!! config))) eqn:Htest.
- rewrite mem_true_iff, Hmove in Htest.
contradiction.
@@ -3195,7 +3197,7 @@ intros da config pt Hssync Hgather. rewrite (round_simplify_Majority).
induction names as [| id l].
+ reflexivity.
+ cbn -[equiv_dec]. destruct_match.
- - elim Hdiff. hnf in *. subst pt'. pattern id. apply no_byz. intro g. apply Hgather.
+ - contradiction Hdiff. hnf in *. subst pt'. pattern id. apply no_byz. intro g. apply Hgather.
- apply IHl. }
rewrite H0. specialize (Hgather g1). rewrite <- Hgather. apply pos_in_config.
Qed.
diff --git a/CaseStudies/Gathering/InR2/Algorithm_withLight.v b/CaseStudies/Gathering/InR2/Algorithm_withLight.v
index 10f19d4a0622a3f89a989b7c09ce5d999491e39a..5f696f2bb183508b83a580555ba893733b55784c 100644
--- a/CaseStudies/Gathering/InR2/Algorithm_withLight.v
+++ b/CaseStudies/Gathering/InR2/Algorithm_withLight.v
@@ -19,7 +19,7 @@
Require Import Bool.
-Require Import Arith.Div2.
+Require Import PeanoNat.
Require Import Lia Field Lra.
Require Import Rbase Rbasic_fun R_sqrt Rtrigo_def.
Require Import List.
@@ -33,6 +33,7 @@ Require Import FunInd.
Require Import FMapFacts.
(* Pactole basic definitions *)
+Require Import Pactole.Util.SetoidDefs.
Require Export Pactole.Setting.
(* Specific to R^2 topology *)
Require Import Pactole.Spaces.R2.
@@ -59,11 +60,9 @@ Remove Hints WithMultiplicityLight.St
FMapFacts.eq_key_Setoid
FMapFacts.eq_key_elt_Setoid : typeclass_instances.
-Local Existing Instance Pactole.Util.FMaps.FMapInterface.prod_Setoid.
-Local Existing Instance Pactole.Util.FMaps.FMapInterface.prod_EqDec.
-Local Existing Instance fst_compat_pactole.
-Local Existing Instance snd_compat_pactole.
-Local Existing Instance pair_compat_pactole.
+(* Local Existing Instance fst_compat_pactole. *)
+(* Local Existing Instance snd_compat_pactole. *)
+(* Local Existing Instance pair_compat_pactole. *)
Local Declare Scope pactole_scope.
@@ -77,7 +76,7 @@ Local Declare Scope pactole_scope.
(** ** Framework of the correctness proof: a finite set with at least three elements **)
-Require Import LibHyps.LibHyps.
+(* Require Import LibHyps.LibHyps.
Local Open Scope autonaming_scope.
@@ -95,7 +94,7 @@ Ltac rename_hyp_1 n th :=
Ltac rename_hyp ::= rename_hyp_1.
Local Close Scope autonaming_scope.
Ltac rename_depth ::= constr:(3).
-
+*)
(* Rewriting tactics to handle Boolean expressions *)
Global Hint Rewrite andb_true_iff andb_false_iff orb_true_iff orb_false_iff
negb_true_iff negb_false_iff eqb_true_iff eqb_false_iff
@@ -216,7 +215,7 @@ Ltac changeR2 :=
Lemma config_list_alls : forall pt, config_list (fun _ => pt) = alls pt nG.
Proof using .
intro. rewrite config_list_spec, map_cst.
-rewrite names_length. simpl. now rewrite plus_0_r.
+rewrite names_length. simpl. now rewrite Nat.add_0_r.
Qed.
Lemma map_sim_support_fst : forall (f : Bijection.bijection location) (obs : observation (Observation := Obs)),
@@ -589,7 +588,11 @@ Proof using.
remember Hbivalent as HBiv.
clear HeqHBiv.
red in Hbivalent.
- decompose [ex and] Hbivalent /n; clear Hbivalent.
+ (* decompose [ex and] Hbivalent /n; clear Hbivalent. *)
+ destruct Hbivalent as [ h_Even_add_nG_nB_
+ [ h_ge_add_nG_nB_2_
+ [ x [ x0 [ h_complement_equiv_location_Setoid_x_x0_
+ [ h_eq_mult_x_div2_add_ h_eq_mult_x0_div2_add_ ]]]]]].
exists x, x0.
repeat split.
+ assumption.
@@ -615,7 +618,10 @@ Proof using.
destruct Hbivalent_on as [x [x0 Hbivalent_on]].
assert (Hbivalent_on' := Hbivalent_on).
unfold bivalent_on in Hbivalent_on.
- decompose [and ex] Hbivalent_on /n; clear Hbivalent_on.
+ (* decompose [and ex] Hbivalent_on /n; clear Hbivalent_on. *)
+ destruct Hbivalent_on as [ h_ge_add_nG_nB_2_
+ [ h_complement_equiv_R2_Setoid_x_x0_
+ [ h_all_or_eq_eq_ h_eq_count_if_count_if_ ]]].
match type of h_eq_count_if_count_if_ with
count_if (fun id => ?a ==b ?b) = _ =>
set (is_notlocx := (fun id : ident => negb (a ==b b))) in *
@@ -726,7 +732,7 @@ Proof using.
match goal with
|- _ = Nat.div2 (?a + ?a) => replace (a + a) with (2 * a)
end.
- -- now rewrite div2_double.
+ -- now rewrite Nat.div2_double.
-- lia.
* unfold count_if in h_eq_count_if_count_if_.
rewrite <- h_eq_count_if_count_if_ in h_permut.
@@ -734,7 +740,7 @@ Proof using.
match goal with
|- _ = Nat.div2 (?a + ?a) => replace (a + a) with (2 * a)
end.
- -- now rewrite div2_double.
+ -- now rewrite Nat.div2_double.
-- lia.
Qed.
@@ -915,6 +921,7 @@ Definition target (s : observation) : location :=
| _ => (* general case *) R2.center (SEC l)
end.
+Typeclasses eauto := (dfs).
Instance target_compat : Proper (equiv ==> Logic.eq) target.
Proof using size_G.
intros s1 s2 Hs. unfold target.
@@ -924,7 +931,9 @@ destruct (on_SEC (support s1)) as [| a1 [| a2 [| a3 [| ? ?]]]] eqn:Hs1.
+ apply Permutation_nil in Hperm. now rewrite Hperm.
+ apply Permutation_length_1_inv in Hperm. now rewrite Hperm.
+ apply Permutation_length_2_inv in Hperm.
- destruct Hperm as [Hperm | Hperm]; rewrite Hperm; trivial; now rewrite Hs.
+ destruct Hperm as [Hperm | Hperm].
+ * rewrite Hperm. now rewrite Hs.
+ * rewrite Hperm. now rewrite Hs.
+ assert (length (on_SEC (support s2)) =3%nat) by now rewrite <- Hperm.
destruct (on_SEC (support s2)) as [| b1 [| b2 [| b3 [| ? ?]]]]; simpl in *; try lia.
apply target_triangle_compat; assumption.
@@ -1186,10 +1195,10 @@ intros config pt. split; intro Hmaj.
simpl equiv. split; intro Hpt.
- subst y. intro x. destruct (equiv_dec x pt).
-- rewrite e. reflexivity.
- -- apply lt_le_weak. now apply Hmaj.
+ -- apply Nat.lt_le_incl. now apply Hmaj.
- destruct (equiv_dec y pt) as [? | Hy]; trivial.
- exfalso. apply (Hmaj y) in Hy. elim (lt_irrefl (!! (config))[pt]).
- eapply le_lt_trans; try eassumption; [].
+ exfalso. apply (Hmaj y) in Hy. elim (Nat.lt_irrefl (!! (config))[pt]).
+ eapply Nat.le_lt_trans; try eassumption; [].
apply Hpt.
* intros y hdiff. apply max_spec_lub.
- rewrite <- support_spec.
@@ -1304,9 +1313,8 @@ assert (Hpt : pt = pt1 \/ pt = pt2).
setoid_rewrite Hmaj.
now left. }
inversion_clear Hin; auto. inversion_clear H0; auto. inversion H1. }
-apply (lt_irrefl (Nat.div2 (nG+nB))). destruct Hpt; subst pt.
+apply (Nat.lt_irrefl (Nat.div2 (nG+nB))). destruct Hpt; subst pt.
- rewrite <- Hpt1 at 2. rewrite <- Hpt2. apply max_spec_lub; try now rewrite Hmax.
- rewrite Hmax. auto.
- rewrite <- Hpt1 at 1. rewrite <- Hpt2. apply max_spec_lub; now rewrite Hmax.
Qed.
@@ -1480,7 +1488,7 @@ Lemma not_bivalent_no_majority_size : forall config,
Proof using size_G.
intros config H1 H2.
assert (size (!! config) > 1)%nat.
-{ unfold gt. eapply lt_le_trans; try eassumption; []. f_equiv. apply max_subset. }
+{ unfold gt. eapply Nat.lt_le_trans; try eassumption; []. f_equiv. apply max_subset. }
destruct (size (!! config)) as [| [| [| ?]]] eqn:Hlen; try lia.
exfalso. apply H2. now rewrite bivalent_equiv.
Qed.
@@ -1521,7 +1529,7 @@ Qed.
Lemma SECT_cardinal_le_nG : forall config, SECT_cardinal (!! config) <= nG.
Proof using .
intro config. unfold SECT_cardinal.
-replace nG with (nG + nB) by (simpl; apply plus_0_r).
+replace nG with (nG + nB) by (simpl; apply Nat.add_0_r).
rewrite <- (cardinal_obs_from_config config (origin,false)).
apply cardinal_sub_compat, filter_subset.
intros ? ? H. now rewrite H.
@@ -2048,7 +2056,7 @@ destruct (existsb (fun x => if get_location (round r da config x) =?= pt then
assert (Hg : forall id, get_location (round r da config id) <> pt \/ get_location (config id) = pt).
{ intro id. specialize (Hex id (In_names _)). revert Hex. repeat destruct_match; try discriminate; auto. }
(** We prove a contradiction by showing that the opposite inequality of Hlt holds. *)
- clear Hex. revert Hlt. apply le_not_lt.
+ clear Hex. revert Hlt. apply Nat.le_ngt.
assert ((@obs_is_ok (location * L) Loc _ MyRobots (@multiset_observation (location * L) Loc St MyRobots)
(!! config) config (origin, witness))).
{ apply obs_from_config_spec. }
@@ -2618,7 +2626,12 @@ assert (Hsim : Proper (equiv ==> equiv) new_frame). { intros ? ? Heq. now rewrit
assert (Proper (equiv ==> equiv) (Bijection.retraction sim)) by now apply Bijection.retraction_compat.
assert (Hinj : Preliminary.injective equiv equiv new_frame) by apply injective.
assert (Hcenter : 0%VS == sim (get_location (config (Good g)))).
-{ rewrite <- (center_prop sim). f_equiv. apply similarity_center. }
+{ rewrite <- (center_prop sim).
+ f_equiv.
+ enough (center sim == get_location (config (Good g))).
+ { apply H1. }
+ changeR2.
+ apply similarity_center. }
set (Psim := precondition_satisfied da config g).
set (local_config := map_config (lift (existT precondition new_frame Psim)) config).
set (local_state := local_config (Good g)).
@@ -2656,7 +2669,7 @@ destruct (bivalent_obs global_obs) eqn:Hcase_biv.
+ intros pt Hpt. rewrite InA_cons, InA_singleton in Hpt.
destruct Hpt as [Hpt | Hpt]; rewrite Hpt.
- rewrite support_spec. apply pos_in_config.
- - rewrite support_spec. apply find_other_loc_In; auto. apply pos_in_config.
+ - rewrite support_spec. apply find_other_loc_In; auto.
+ rewrite have_support; auto. rewrite <- bivalent_obs_spec. apply Hcase_biv.
+ rewrite <- bivalent_obs_spec. apply Hcase_biv. }
destruct (color_bivalent_obs global_obs) eqn:Hcase_col_biv;
@@ -2676,6 +2689,7 @@ destruct (bivalent_obs global_obs) eqn:Hcase_biv.
destruct Hperm as [[Heq1 Heq2] | [Heq1 Heq2]];
rewrite <- Heq1, <- Heq2; auto using middle_comm.
+ (* color bivalent and black observer *)
+ Typeclasses eauto := (dfs) 5.
rewrite Hcenter. split; try reflexivity; [].
apply Bijection.retraction_section.
+ (* bivalent but not color bivalent *)
@@ -3058,7 +3072,7 @@ destruct (obs_from_config_spec (round gatherR2 da config) (0%VS, witness)) as [H
specialize (Hobs' pt). rewrite <- obs_fst in Hobs'. changeR2. rewrite Hobs'.
do 2 rewrite config_list_spec, map_map, count_filter_length, filter_map, map_length.
f_equiv. apply eqlistA_PermutationA, filter_extensionalityA_compat; try reflexivity; [].
-intros xx id ?; subst xx.
+intros xx id h. rewrite h.
repeat destruct_match; try reflexivity; [|]; rewrite (a3b_next_round id) in *;
destruct (activate da id); contradiction.
Qed.
@@ -3290,6 +3304,7 @@ repeat split; auto; changeR2.
{ intros c l xx id ?. subst xx. destruct (get_light (c id)), l; reflexivity. }
destruct col.
+ (* white *)
+ Typeclasses eauto := (dfs).
rewrite 2 idle_on_split.
repeat rewrite ?filter_app, <- ?filter_andb, ?app_length.
unfold light_idle_on.
@@ -3304,7 +3319,7 @@ repeat split; auto; changeR2.
{ intro pt. unfold active_on, active.
rewrite <- 3 filter_andb. f_equiv.
apply eqlistA_PermutationA, filter_extensionalityA_compat; try reflexivity; [].
- intros xx id ?. subst xx.
+ intros xx id h. rewrite h.
rewrite a3b_next_white_eqb, a3b_same_loc; trivial; [].
destruct (activate da id) eqn:Hid; now simpl_bool. }
rewrite 2 Hlen', 2 a3b_next_white_idle_is_white; trivial; [].
@@ -3325,7 +3340,7 @@ repeat split; auto; changeR2.
change 0 with (length (@nil ident)). rewrite <- (filter_false names).
rewrite <- 2 filter_andb. f_equiv.
apply eqlistA_PermutationA, filter_extensionalityA_compat; try reflexivity; [].
- intros xx id ?. subst xx.
+ intros xx id h. rewrite h.
rewrite a3b_next_black_eqb, a3b_same_loc; trivial; [].
destruct (activate da id) eqn:Hid; now simpl_bool. }
rewrite 2 Hlen', 2 a3b_next_black_idle_is_black_idle; trivial; [].
@@ -3644,9 +3659,9 @@ assert (Hmult : (!! config)[get_location (config id1)] = Nat.div2 (nG + nB)).
apply (bivalent_support (config := config)); auto. }
rewrite PermutationA_2 in Hperm; auto; [].
destruct Hperm as [[Heq _] | [Heq _ ]]; rewrite Heq; auto. }
-apply lt_le_trans with (length (moving gatherR2 da config)).
+apply Nat.lt_le_trans with (length (moving gatherR2 da config)).
+ cut (incl (id2 :: on_loc (get_location (config id1)) config) (moving gatherR2 da config)).
- { intro Hincl. eapply lt_le_trans; [| apply NoDup_incl_length; [| eassumption]].
+ { intro Hincl. eapply Nat.lt_le_trans; [| apply NoDup_incl_length; [| eassumption]].
+ cbn [length]. erewrite <- obs_from_config_on_loc, Hmult. lia.
+ constructor.
- now rewrite on_loc_spec.
@@ -4172,6 +4187,7 @@ destruct (active da) as [| id l] eqn:Hactive.
* now apply black_dont_move.
* now apply black_dont_move.
+ assert ((get_location (config id_black) == pt2)) as h_idblack_pt2.
+ Typeclasses eauto := (bfs).
{ apply bivalent_same_location with (pt3:=pt1) (config:=config) (st:=(0%VS, witness)); auto. }
assert (exists id_black2, is_black config id_black2
/\ (get_location (config id_black2) == pt1)) as hex.
@@ -4200,6 +4216,7 @@ destruct (active da) as [| id l] eqn:Hactive.
exists id_black2.
unfold is_black.
changeR2.
+ Typeclasses eauto := (dfs) 7.
rewrite hblack2.
split;auto. }
destruct hex as [id_black2 [h_black2 hloc2]].
@@ -4210,7 +4227,6 @@ destruct (active da) as [| id l] eqn:Hactive.
* now apply black_dont_move.
* now apply black_dont_move. }
{ (* All robots are white *)
- /g.
(* let us simplify hypothesis *)
apply Classical_Prop.imply_and_or in h_cb_b_allw.
2:{ contradiction. }
@@ -4225,7 +4241,7 @@ destruct (active da) as [| id l] eqn:Hactive.
- (* (h_cb_nb_wm idopp) proves that there is a robot id' opposite
to id_move that does not move. *)
assert (exists id', get_location (config id') <> get_location (config id_move)
- /\ ~ is_moving gatherR2 da config id') as [id' [h_id'_otherloc h_id'_nomove]]/g.
+ /\ ~ is_moving gatherR2 da config id') as [id' [h_id'_otherloc h_id'_nomove]].
{ (* We need a robot idopp not colocated with id_move. *)
destruct (bivalent_exists_opposite_id id_move (color_bivalent_bivalent Hcolor)) as [idopp h_idopp].
@@ -4243,7 +4259,7 @@ destruct (active da) as [| id l] eqn:Hactive.
/\ ~ is_moving gatherR2 da config id'')
\/ ~(exists id'', get_location (config id'') = get_location (config id_move)
/\ ~ is_moving gatherR2 da config id''))
- as [[id'' [h_id''_loc h_id''_move]]| h] /g.
+ as [[id'' [h_id''_loc h_id''_move]]| h].
{ setoid_rewrite <- exists_ident.
apply Exists_decidable.
intros x.
@@ -4376,7 +4392,7 @@ destruct (active da) as [| id l] eqn:Hactive.
apply h_not_div2_active.
rewrite all_white_active_moving; auto.
- assert (exists id', get_location (config id') <> get_location (config id_move)
- /\ ~ is_moving gatherR2 da config id') as [id' [h_id'_otherloc h_id'_nomove]]/g.
+ /\ ~ is_moving gatherR2 da config id') as [id' [h_id'_otherloc h_id'_nomove]].
{ (* We need a robot idopp not colocated with id_move. *)
destruct (bivalent_exists_opposite_id id_move (color_bivalent_bivalent Hcolor)) as [idopp h_idopp].
(* now we can apply h_cb_nb_wm on it to obtain a stationary one. *)
@@ -4397,7 +4413,7 @@ destruct (active da) as [| id l] eqn:Hactive.
/\ ~ is_moving gatherR2 da config id'')
\/ ~(exists id'', get_location (config id'') = get_location (config id_move)
/\ ~ is_moving gatherR2 da config id''))
- as [[id'' [h_id''_loc h_id''_move]]| h] /g.
+ as [[id'' [h_id''_loc h_id''_move]]| h].
{ setoid_rewrite <- exists_ident.
apply Exists_decidable.
intros x.
@@ -4527,7 +4543,6 @@ destruct (active da) as [| id l] eqn:Hactive.
apply (h _ c).
rewrite h_iff.
now apply active_spec. }
- /g.
destruct (activate da a) eqn:h_activate.
- apply active_spec in h_activate.
assert (get_location (config id) == get_location (config id_move)) as h_loc_id.
@@ -4802,6 +4817,7 @@ cut ((forall pt, pt =/= pt' -> (!! (round gatherR2 da config))[pt] <= (!! config
+ now rewrite moving_spec in Hmove. }
(* We prove the large inequalities. *)
setoid_rewrite round_simplify_bivalent.
+Typeclasses eauto := (bfs) 8.
setoid_rewrite WithMultiplicityLight.obs_from_config_fst_spec; try exact (origin,witness) ; [].
repeat rewrite config_list_spec. repeat rewrite List.map_map.
induction names as [| id' l]; cbn [List.map].
@@ -4886,7 +4902,7 @@ assert (Hsame : (!! config)[pt_id] = (!! config)[pt'_id]).
exists pt'_id.
intros pt Hneq.
destruct (pt =?= pt_id) as [Hcase | Hcase].
-* apply le_lt_trans with ((!! config)[pt_id]).
+* apply Nat.le_lt_trans with ((!! config)[pt_id]).
+ rewrite Hcase. now apply Hwither.
+ rewrite Hsame. apply Hgrow.
* assert (Hout : (!! (round gatherR2 da config))[pt] = 0).
@@ -5039,7 +5055,7 @@ split; trivial; [].
destruct (le_lt_dec ((!! config)[x]) 0); trivial; [].
exfalso.
destruct (@increase_move gatherR2 da config x) as [r_moving [Hdest_rmoving Hrmoving]].
-* simpl in *. now apply le_lt_trans with 0.
+* simpl in *. now apply Nat.le_lt_trans with 0.
* destruct (le_lt_dec 2 (length (support (max (!! config))))) as [Hle | Hlt].
+ rewrite destination_is_target in Hdest_rmoving.
- now elim Heq.
@@ -5172,6 +5188,7 @@ intros Hmaj Hclean. apply (NoDupA_equivlistA_PermutationA _).
+ rewrite support_spec, (obs_from_config_In config) in Hin. destruct Hin as [id Hid].
rewrite <- Hid in *.
assert (Heq : round gatherR2 da config id == config id) by now apply dirty_next_still_on_SEC.
+ Typeclasses eauto := (dfs) 7.
rewrite <- Heq, support_spec. apply pos_in_config.
Qed.
@@ -5184,6 +5201,7 @@ Theorem Majority_grow : forall pt, MajTower_at pt config ->
Proof using Hssync Hbivalent.
intros pt Hmaj.
rewrite (round_simplify_Majority Hmaj).
+Typeclasses eauto := (bfs) 7.
setoid_rewrite WithMultiplicityLight.obs_from_config_fst_spec; try exact (origin,witness) ; [].
do 2 rewrite config_list_spec.
induction names as [| id l]; cbn -[get_location].
@@ -5215,7 +5233,7 @@ Theorem MajTower_at_forever : forall pt,
MajTower_at pt config -> MajTower_at pt (round gatherR2 da config).
Proof using Hssync Hbivalent.
intros pt Hmaj x Hx. assert (Hs := Hmaj x Hx).
-apply le_lt_trans with ((!! config)[x]); try eapply lt_le_trans; try eassumption; [|].
+apply Nat.le_lt_trans with ((!! config)[x]); try eapply Nat.lt_le_trans; try eassumption; [|].
- eapply Majority_wither; eauto.
- eapply Majority_grow; eauto.
Qed.
@@ -5410,7 +5428,7 @@ destruct (support (max (!! config))) as [| pt [| pt' l']] eqn:Hmaj.
rewrite <- changing_eq_moving, Heq.
- now left.
- auto using color_bivalent_bivalent. }
- assert ((div2 nG) <= (!! config)[pt']).
+ assert ((Nat.div2 nG) <= (!! config)[pt']).
{ transitivity ((!! (round gatherR2 da config))[pt']).
- decompose [and or] Hpt; clear Hpt; subst.
+ setoid_rewrite Hpt2. simpl.
@@ -5428,22 +5446,22 @@ destruct (support (max (!! config))) as [| pt [| pt' l']] eqn:Hmaj.
rewrite <- Hid1.
symmetry.
apply Hdest. rewrite moving_spec. intro Habs. apply Hid2. now rewrite Habs. }
- assert (Hlt : forall p, p <> pt' -> (!! config)[p] < div2 nG).
+ assert (Hlt : forall p, p <> pt' -> (!! config)[p] < Nat.div2 nG).
{ assert (Hpt'_in : In pt' (!! config)).
- { unfold In. eapply lt_le_trans; try eassumption. apply Exp_prop.div2_not_R0. lia. }
+ { unfold In. eapply Nat.lt_le_trans; try eassumption. apply Exp_prop.div2_not_R0. lia. }
assert (Hle := not_bivalent_no_majority_size Hmaj Hbivalent).
- intros p Hp. apply Nat.nle_gt. intro Habs. apply (lt_irrefl nG).
+ intros p Hp. apply Nat.nle_gt. intro Habs. apply (Nat.lt_irrefl nG).
destruct (@towers_elements_3 config pt' p Hle Hpt'_in) as [pt3' [Hdiff13 [Hdiff23 Hpt3_in]]]; trivial.
- + apply lt_le_trans with (div2 nG); trivial; []. apply Exp_prop.div2_not_R0. lia.
+ + apply Nat.lt_le_trans with (Nat.div2 nG); trivial; []. apply Exp_prop.div2_not_R0. lia.
+ auto.
+ rewrite <- Nat.add_0_r, <- nB_eq_0.
- eapply lt_le_trans.
+ eapply Nat.lt_le_trans.
all: swap 1 2.
* apply (sum3_le_total config (origin,witness) Hp Hdiff13 Hdiff23).
- * unfold In in Hpt3_in. rewrite <- ?Even.even_equiv in *.
- rewrite <- obs_fst, (even_double nG); auto; []. changeR2. unfold Nat.double. lia. }
+ * unfold In in Hpt3_in.
+ rewrite <- obs_fst, (Nat.Even_double nG); auto; []. changeR2. unfold Nat.double. lia. }
assert (Hmaj' : MajTower_at pt' config).
- { intros x Hx. apply lt_le_trans with (div2 nG); trivial. now apply Hlt. }
+ { intros x Hx. apply Nat.lt_le_trans with (Nat.div2 nG); trivial. now apply Hlt. }
apply MajTower_at_equiv in Hmaj'.
red in Hmaj.
rewrite size_spec in Hmaj.
@@ -5535,7 +5553,10 @@ destruct (on_SEC (support (!! (round gatherR2 da config))))
as [| ptx' [| pty' [| ? ?]]] eqn:Hsec'; cbn in Hlen; try discriminate.
do 2 rewrite SEC_on_SEC, ?Hsec, ?Hsec', SEC_dueton. simpl.
apply (PermutationA_2 _) in HpermSEC'.
-destruct HpermSEC' as [[Heq1 Heq2] | [Heq1 Heq2]]; rewrite Heq1, Heq2; trivial || apply middle_comm.
+destruct HpermSEC' as [[Heq1 Heq2] | [Heq1 Heq2]].
+Typeclasses eauto := (dfs).
+- changeR2. rewrite Heq1. rewrite Heq2. trivial.
+- changeR2. rewrite Heq1. rewrite Heq2. apply middle_comm.
Qed.
Lemma clean_diameter_next_maj_or_diameter : forall ptx pty,
@@ -6229,7 +6250,7 @@ destruct (support (max (!! (round gatherR2 da config)))) as [| pt1 [| pt2 l]] eq
++ assert (Hperm' : PermutationA equiv (support (!! (round gatherR2 da config)))
(isobarycenter ([ptx; pty; ptz]) :: [ptx; pty; ptz])).
{ assert ((!! (round gatherR2 da config))[target (!! config)] > 0).
- { apply le_lt_trans with ((!! config)[target (!! config)]); try lia; [].
+ { apply Nat.le_lt_trans with ((!! config)[target (!! config)]); try lia; [].
rewrite (increase_move_iff Hssync non_bivalent_same_destination); trivial; [].
exists gmove. split.
- apply destination_is_target; trivial.
@@ -7019,7 +7040,8 @@ intros da config pt Hssync Hgather. rewrite (round_simplify_Majority).
+ assumption.
+ intros pt' Hdiff.
assert (H0 : (!! config)[pt'] = 0%nat).
- { setoid_rewrite WithMultiplicityLight.obs_from_config_fst_spec; try exact (origin,witness); [].
+ { setoid_rewrite WithMultiplicityLight.obs_from_config_fst_spec.
+ 2:{ try exact (origin,witness). }
rewrite config_list_spec.
induction names as [| id l].
+ reflexivity.
diff --git a/CaseStudies/Gathering/InR2/FSyncFlexNoMultAlgorithm.v b/CaseStudies/Gathering/InR2/FSyncFlexNoMultAlgorithm.v
index 2146fc56871a58cd5ffcb80c752ebf59358dac07..57af3eae0f947e5a5d79407b52f6af0bada36973 100644
--- a/CaseStudies/Gathering/InR2/FSyncFlexNoMultAlgorithm.v
+++ b/CaseStudies/Gathering/InR2/FSyncFlexNoMultAlgorithm.v
@@ -10,7 +10,6 @@
(**************************************************************************)
Require Import Bool.
-Require Import Arith.Div2.
Require Import Lia Field.
Require Import Rbase Rbasic_fun R_sqrt Rtrigo_def.
Require Import List.
@@ -20,7 +19,8 @@ Require Import RelationPairs.
Require Import Morphisms.
Require Import Psatz.
Require Import Inverse_Image.
-Require Import Pactole.Setting.
+Require Import Pactole.Util.Bijection.
+Require Import Pactole.Setting Pactole.Util.Fin.
Require Import Pactole.Models.Flexible.
Require Import Pactole.Models.NoByzantine.
Require Import Pactole.Observations.SetObservation.
@@ -29,7 +29,7 @@ Require Import Pactole.CaseStudies.Gathering.Definitions.
Set Implicit Arguments.
-Typeclasses eauto := (bfs) 10.
+(* Typeclasses eauto := (bfs) 10. *)
(** * The Gathering Problem **)
@@ -42,11 +42,10 @@ Typeclasses eauto := (bfs) 10.
(** ** Framework of the correctness proof: a finite set with at least two elements **)
Section GatheringInR2.
-Variable n : nat.
-Hypothesis size_G : (2 <= n)%nat.
+Context {k : nat} {ltc_1_k : 1 <c k}.
(** There are n good robots and no byzantine ones. *)
-Instance MyRobots : Names := Robots n 0.
+Instance MyRobots : Names := Robots k 0.
Instance NoByz : NoByzantine.
Proof using . now split. Qed.
@@ -85,7 +84,7 @@ Instance Robot : robot_choice (path location) := { robot_choice_Setoid := path_S
(** In a flexible setting, the minimum distance that robots are allowed to move is delta. *)
Variable delta : R.
-Lemma inactive_proper : Proper (equiv ==> eq ==> equiv ==> equiv)
+Lemma inactive_proper : Proper (equiv ==> eq ==> equiv ==> @equiv location location_Setoid)
(fun (config : configuration) (id : ident) (_ : unit) => config id).
Proof using . repeat intro; subst; auto. Qed.
@@ -115,7 +114,8 @@ Arguments dist : simpl never.
Definition path_R2 := path location.
Definition paths_in_R2 : location -> path_R2 := local_straight_path.
(* TODO: understand the warning here. *)
-Coercion paths_in_R2 : location >-> path_R2.
+#[local,warnings="-uniform-inheritance"]
+ Coercion paths_in_R2 : location >-> path_R2.
Instance paths_in_R2_compat : Proper (@equiv _ location_Setoid ==> equiv) paths_in_R2.
Proof using . intros pt1 pt2 Heq. now rewrite Heq. Qed.
@@ -128,31 +128,28 @@ Proof using . intros ? ? Heq. apply no_byz_eq. intro. apply Heq. Qed.
Lemma config_list_alls : forall pt, config_list (fun _ => pt) = alls pt nG.
Proof using .
intro. rewrite config_list_spec, map_cst.
-setoid_rewrite names_length. simpl. now rewrite plus_0_r.
+rewrite names_length. simpl. now rewrite Nat.add_0_r.
Qed.
(** Define one robot to get their location whenever they are gathered. *)
-Definition g1 : G.
-Proof.
-exists 0%nat. abstract (pose (Hle := size_G); lia).
-Defined.
+Definition g1 : G := fin0.
(* Definition Spect_map f s := Spect.M.fold (fun e acc => Spect.M.add (f e) acc) s Spect.M.empty. *)
Lemma map_sim_elements : forall (sim : similarity location) s,
PermutationA equiv (elements (map sim s)) (List.map sim (elements s)).
-Proof using . intros. apply map_injective_elements; autoclass; apply Similarity.injective. Qed.
+Proof using . intros. eapply map_injective_elements; autoclass; apply Similarity.injective. Qed.
(** Spectra can never be empty as the number of robots is non null. *)
Lemma obs_non_nil : forall config, !! config =/= empty.
-Proof using size_G.
+Proof using ltc_1_k.
intros config Habs.
specialize (Habs (get_location (config (Good g1)))). rewrite empty_spec in Habs.
rewrite <- Habs. apply pos_in_config.
Qed.
Lemma elements_non_nil : forall config, elements (!! config) <> nil.
-Proof using size_G. intro. rewrite elements_nil. apply obs_non_nil. Qed.
+Proof using ltc_1_k. intro. rewrite elements_nil. apply obs_non_nil. Qed.
(* We need to unfold [obs_is_ok] for rewriting *)
Definition obs_from_config_spec : forall (config : configuration) pt,
@@ -219,17 +216,17 @@ Instance measure_compat : Proper (equiv ==> eq) measure.
Proof using . intros ? ? Heq. unfold measure. now rewrite Heq. Qed.
Lemma measure_nonneg : forall config, 0 <= measure config.
-Proof using size_G.
+Proof using ltc_1_k.
intros config. unfold measure.
destruct (elements (!! config)) as [| pt l] eqn:Heq.
-+ elim (elements_non_nil _ Heq).
++ contradiction (elements_non_nil _ Heq).
+ rewrite <- (R2_dist_defined_2 pt). apply max_dist_obs_le; rewrite Heq; now left.
Qed.
(** The minimum value 0 is reached only on gathered configurations. *)
Lemma gathered_elements : forall config pt,
gathered_at pt config <-> PermutationA (@equiv _ location_Setoid) (elements (!! config)) (pt :: nil).
-Proof using size_G.
+Proof using ltc_1_k.
intros config pt.
split; intro H.
* apply NoDupA_equivlistA_PermutationA; autoclass.
@@ -251,7 +248,7 @@ split; intro H.
Qed.
Lemma gathered_measure : forall config, measure config = 0%R <-> exists pt, gathered_at pt config.
-Proof using size_G.
+Proof using ltc_1_k.
intros config. split; intro H.
* unfold measure, max_dist_obs in *.
assert (Hnil := elements_non_nil config).
@@ -268,7 +265,7 @@ intros config. split; intro H.
cut (length (pt' :: l) = length (x :: nil)); try (simpl; lia).
f_equiv; eauto. }
subst. rewrite PermutationA_1 in Hperm; autoclass; [].
- elim H2. left.
+ contradiction H2. left.
cbn in H. do 2 rewrite R2_dist_defined_2 in H.
cbn in H. setoid_rewrite (Rmax_comm 0)%R in H. rewrite (Rmax_left 0 0)%R in H; try reflexivity; [].
rewrite dist_sym in H. repeat (rewrite (Rmax_left (dist pt' pt) 0) in H; try apply dist_nonneg).
@@ -323,7 +320,10 @@ assert (Hperm : PermutationA equiv (List.map sim (elements (!! config)))
(elements (!! (map_config sim config)))).
{ rewrite <- map_injective_elements, obs_from_config_map, obs_from_config_ignore_snd;
autoclass; reflexivity || apply Bijection.injective. }
+Typeclasses eauto := (bfs) 10.
rewrite (obs_from_config_ignore_snd origin).
+Typeclasses eauto := (dfs).
+
change (lift (existT _ ?x _)) with x.
change get_location with (@Datatypes.id location). unfold Datatypes.id.
simpl pgm. unfold ffgatherR2_pgm. changeR2.
@@ -342,7 +342,6 @@ apply (update_compat
config); auto.
+ rewrite <- (map_config_id config) at 2. rewrite map_config_merge.
- f_equiv. intros x y Hxy. simpl. now rewrite Bijection.retraction_section.
- - auto.
- simpl. repeat intro. now subst.
+ unfold lift_path; cbn -[straight_path isobarycenter].
intro. now rewrite Bijection.retraction_section, Hda.
@@ -356,7 +355,7 @@ Theorem round_lt_config : forall da config,
FSYNC_da da ->
delta <= measure config ->
measure (round ffgatherR2 da config) <= measure config - delta.
-Proof using size_G.
+Proof using ltc_1_k.
intros da config Hdelta HFSync Hnotdone.
set (elems := elements (!! config)).
set (C := isobarycenter elems).
@@ -573,7 +572,7 @@ Theorem round_last_step : forall da config,
FSYNC_da da ->
measure config <= delta ->
measure (round ffgatherR2 da config) == 0.
-Proof using size_G.
+Proof using ltc_1_k.
intros da config Hdelta HFSync Hlt.
unfold measure.
set (elems := (elements (!! config))).
@@ -633,7 +632,7 @@ Proof using . unfold lt_config. apply wf_inverse_image, lt_wf. Qed.
Lemma lt_config_decrease : 0 < delta -> forall config1 config2,
measure config1 <= measure config2 - delta -> lt_config delta config1 config2.
-Proof using size_G.
+Proof using ltc_1_k.
intros Hdelta config1 config2 Hle. unfold lt_config.
rewrite <- Z2Nat.inj_lt.
+ apply Zup_lt. field_simplify; try lra. unfold Rdiv. apply Rmult_le_compat.
@@ -653,7 +652,7 @@ Qed.
Lemma gathered_precise : forall config pt,
gathered_at pt config -> forall id, gathered_at (config id) config.
-Proof using size_G.
+Proof using .
intros config pt Hgather id id'. transitivity pt.
- apply Hgather.
- symmetry. apply (no_byz id), Hgather.
@@ -668,7 +667,7 @@ Lemma not_gathered_exists : forall config pt,
Proof.
intros config pt Hgather.
destruct (forallb (fun x => R2dec_bool (config x) pt) names) eqn:Hall.
-- elim Hgather. rewrite forallb_forall in Hall.
+- contradiction Hgather. rewrite forallb_forall in Hall.
intro id'. setoid_rewrite R2dec_bool_true_iff in Hall.
hnf. repeat rewrite Hall; trivial; apply In_names.
- rewrite <- negb_true_iff, existsb_forallb, existsb_exists in Hall.
@@ -679,7 +678,7 @@ Qed.
*)
Lemma gathered_at_elements : forall config pt,
gathered_at pt config -> PermutationA equiv (elements (!! config)) (pt :: nil).
-Proof using size_G.
+Proof using ltc_1_k.
intros config pt Hgather.
apply NoDupA_equivlistA_PermutationA; autoclass.
+ apply elements_NoDupA.
@@ -694,7 +693,7 @@ Qed.
Lemma gathered_at_forever : forall da config pt, FSYNC_da da ->
gathered_at pt config -> gathered_at pt (round ffgatherR2 da config).
-Proof using size_G.
+Proof using ltc_1_k.
intros da config pt Hda Hgather g.
rewrite round_simplify; trivial; []. cbn zeta.
rewrite (gathered_at_elements Hgather), isobarycenter_singleton.
@@ -703,7 +702,7 @@ Qed.
Lemma gathered_at_OK : forall d conf pt, FSYNC (similarity_demon2demon d) ->
gathered_at pt conf -> Gather pt (execute ffgatherR2 d conf).
-Proof using size_G.
+Proof using ltc_1_k.
cofix Hind. intros d conf pt [] Hgather. constructor.
+ clear Hind. simpl. assumption.
+ rewrite execute_tail. apply Hind; now try apply gathered_at_forever.
@@ -738,7 +737,7 @@ Qed.
(** The final theorem. *)
Theorem FSGathering_in_R2 :
forall d, delta > 0 -> FSYNC (similarity_demon2demon d) -> FullSolGathering ffgatherR2 d.
-Proof using size_G.
+Proof using ltc_1_k.
intros d Hdelta HFS config. revert d HFS. pattern config.
apply (well_founded_ind (wf_lt_config Hdelta)). clear config.
intros config Hind [da d] [Hda HFS].
diff --git a/CaseStudies/Gathering/InR2/Peleg.v b/CaseStudies/Gathering/InR2/Peleg.v
index 80d03a76172ba3d63b6a964b2222758b9f84ee1d..eba8f8d98228828c3d9318eb99a94599848251d5 100644
--- a/CaseStudies/Gathering/InR2/Peleg.v
+++ b/CaseStudies/Gathering/InR2/Peleg.v
@@ -10,7 +10,6 @@
(**************************************************************************)
Require Import Bool.
-Require Import Arith.Div2.
Require Import Lia Field.
Require Import Rbase Rbasic_fun R_sqrt Rtrigo_def.
Require Import List.
@@ -21,6 +20,7 @@ Require Import Morphisms.
Require Import Psatz.
Require Import Inverse_Image.
Require Import Pactole.Setting.
+Require Import Pactole.Util.Bijection.
Require Import Pactole.Models.Flexible.
Require Import Pactole.Models.NoByzantine.
Require Import Pactole.Observations.MultisetObservation.
@@ -31,7 +31,7 @@ Require Import Pactole.CaseStudies.Gathering.Definitions.
Import Permutation.
Set Implicit Arguments.
-Typeclasses eauto := (bfs) 10.
+(* Typeclasses eauto := (bfs) 10. *)
(** * The Gathering Problem **)
@@ -111,7 +111,8 @@ Arguments dist : simpl never.
(* The robot trajectories are straight paths. *)
Definition path_R2 := path location.
Definition paths_in_R2 : location -> path_R2 := local_straight_path.
-Coercion paths_in_R2 : location >-> path_R2.
+#[local,warnings="-uniform-inheritance"]
+ Coercion paths_in_R2 : location >-> path_R2.
Instance paths_in_R2_compat : Proper (@equiv _ location_Setoid ==> equiv) paths_in_R2.
Proof using . intros pt1 pt2 Heq. now rewrite Heq. Qed.
@@ -125,8 +126,11 @@ Proof using . intros. apply no_byz_eq. intro. now apply WithMultiplicity.no_info
Lemma config_list_alls : forall pt, config_list (fun _ => pt) = alls pt nG.
Proof using .
intro. rewrite config_list_spec, map_cst.
-setoid_rewrite names_length. simpl. now rewrite plus_0_r.
+Typeclasses eauto := (bfs) 10.
+setoid_rewrite names_length. simpl. now rewrite Nat.add_0_r.
Qed.
+Typeclasses eauto := (dfs).
+
(** Define one robot to get their location whenever they are gathered. *)
Definition g1 : G.
@@ -189,7 +193,7 @@ Lemma max_dist_obs_le :
InA equiv pt0 (support s) ->
InA equiv pt1 (support s) ->
dist pt0 pt1 <= max_dist_obs s.
-Proof using . intros. now apply max_dist_list_list_le. Qed.
+Proof using . intros. now apply @max_dist_list_list_le. Qed.
Lemma max_dist_obs_ex :
forall (s : observation),
@@ -214,7 +218,7 @@ Lemma measure_nonneg : forall config, 0 <= measure config.
Proof using size_G.
intros config. unfold measure.
destruct (support (!! config)) as [| pt l] eqn:Heq.
-+ rewrite support_nil in Heq. elim (obs_non_nil _ Heq).
++ rewrite support_nil in Heq. contradiction (obs_non_nil _ Heq).
+ rewrite <- (R2_dist_defined_2 pt). apply max_dist_obs_le; rewrite Heq; now left.
Qed.
@@ -258,7 +262,7 @@ intros config. split; intro H.
cut (length (pt' :: l) = length (x :: nil)); try (simpl; lia).
f_equiv; eauto. }
subst. rewrite PermutationA_1 in Hperm; autoclass; [].
- elim H2. left.
+ contradiction H2. left.
cbn in H. do 2 rewrite R2_dist_defined_2 in H.
rewrite (Rmax_left 0 0) in H; try reflexivity; [].
rewrite dist_sym in H. rewrite (Rmax_comm 0) in H.
@@ -329,7 +333,9 @@ assert (Hperm : PermutationA (equiv * eq)%signature
(precondition_satisfied da config g))) config)))).
{ rewrite <- map_injective_elements, obs_from_config_map, obs_from_config_ignore_snd;
autoclass; reflexivity || apply Bijection.injective. }
-rewrite obs_from_config_ignore_snd.
+Typeclasses eauto := (bfs) 10.
+rewrite @obs_from_config_ignore_snd.
+Typeclasses eauto := (dfs).
simpl pgm. unfold ffgatherR2_pgm. changeR2.
remember (elements (!! config)) as E.
apply (@PermutationA_map _ _ _ (equiv * eq)%signature _ (fun xn => (fst xn, INR (snd xn)))) in Hperm;
@@ -362,7 +368,6 @@ apply get_location_compat, update_compat; auto.
(lift (existT precondition (frame_choice_bijection sim)
(precondition_satisfied da config g)) x))); try reflexivity; [].
rewrite 2 get_location_lift. simpl. rewrite Bijection.retraction_section. apply Hxy.
- - autoclass.
- apply lift_compat. intros x y Hxy. now rewrite Hxy.
+
Admitted. (* Peleg's gathering in FSYNC: round_simplify -> hypothesis missing on the demon *)
@@ -708,7 +713,7 @@ Lemma not_gathered_exists : forall config pt,
Proof.
intros config pt Hgather.
destruct (forallb (fun x => R2dec_bool (config x) pt) names) eqn:Hall.
-- elim Hgather. rewrite forallb_forall in Hall.
+- contradiction Hgather. rewrite forallb_forall in Hall.
intro id'. setoid_rewrite R2dec_bool_true_iff in Hall.
hnf. repeat rewrite Hall; trivial; apply In_names.
- rewrite <- negb_true_iff, existsb_forallb, existsb_exists in Hall.
diff --git a/CaseStudies/Gathering/InR2/Viglietta.v b/CaseStudies/Gathering/InR2/Viglietta.v
index cba28361584a1f978911f5ec476d27b3b87dfce8..5189d4e7c220bc3e90bea0ca468ff52f71855a9b 100644
--- a/CaseStudies/Gathering/InR2/Viglietta.v
+++ b/CaseStudies/Gathering/InR2/Viglietta.v
@@ -10,7 +10,7 @@
- me=B, you=B: stay, light goes to A *)
Require Import Lia.
-Require Import Pactole.Setting.
+Require Import Pactole.Setting Pactole.Util.Fin.
Require Import Pactole.Spaces.R.
Require Import Pactole.Spaces.R2.
Require Import Pactole.Models.Similarity.
@@ -18,7 +18,6 @@ Require Import Pactole.Models.NoByzantine.
Require Import Pactole.CaseStudies.Gathering.Definitions.
(* Helping typeclass resolution avoid infinite loops. *)
-Typeclasses eauto := (bfs).
(* Avoid problems with previous instances. *)
Remove Hints eq_setoid : typeclass_instances.
@@ -34,16 +33,16 @@ Instance NoByz : NoByzantine.
Proof using . now split. Qed.
Notation lt2 := (fun x => x < 2)%nat.
-Definition lt02 : (0 < 2)%nat := ltac:(abstract lia).
+Definition lt02 : (0 < 2)%nat := ltac:(abstract auto).
Definition lt12 : (1 < 2)%nat := ltac:(abstract lia).
-Definition r0 : G := exist lt2 0%nat lt02.
-Definition r1 : G := exist lt2 1%nat lt12.
+Definition r0 : G := Fin lt02.
+Definition r1 : G := Fin lt12.
Lemma id_case : forall id, id = Good r0 \/ id = Good r1.
Proof using .
intros [[[| [| ?]] ?] | []]; simpl;
solve [ exfalso; lia
- | now left + right; f_equal; apply eq_proj1 ].
+ | now left + right; f_equal; apply fin2natI ].
Qed.
(** The space is R², so that we can define similarities and they respect middle points. *)
@@ -211,7 +210,7 @@ assert (Hpt1 : pt1 == pt) by now rewrite <- Hgather, Hr0.
assert (Hpt2 : pt2 == pt) by now rewrite <- Hgather, Hr1.
assert (Hg : g = r0 \/ g = r1).
{ destruct g as [[| [| ?]] ?].
- - left. unfold r0. f_equal. apply le_unique.
+ - left. unfold r0. unfold fin0. f_equal. apply le_unique.
- right. unfold r1. f_equal. apply le_unique.
- exfalso. lia. }
destruct Hg; subst g.
@@ -364,9 +363,9 @@ destruct (config (Good r0)) as [pt1 l1] eqn:Hr0,
assert (Hpt : pt1 =/= pt2).
{ intro Habs. rewrite Habs in Hr0. apply Hnotgather.
exists (get_location (config (Good r0))). intros [[| [| ?]] ?]; simpl.
- + unfold r0. do 4 f_equal. now apply eq_proj1.
+ + unfold r0. do 4 f_equal. now apply fin2natI.
+ transitivity (Datatypes.id (fst (config (Good r1)))).
- - unfold r1. simpl. do 4 f_equal. now apply eq_proj1.
+ - unfold r1. simpl. do 4 f_equal. now apply fin2natI.
- now rewrite Hr0, Hr1.
+ exfalso. lia. }
destruct l1 eqn:Hl1; [| destruct l2 eqn:Hl2].
@@ -452,7 +451,7 @@ destruct (gathered_at_dec config (get_location (config (Good r0)))) as [Hgather
apply (Hind (measure (round rendezvous (Stream.hd d) config))).
++ subst n. destruct (round_measure (Stream.hd d) config) as [[pt Hpt] | ?]; trivial; [|].
-- apply Hsim.
- -- elim Hgather'. now rewrite (Hpt r0).
+ -- contradiction Hgather'. now rewrite (Hpt r0).
++ apply Hfair.
++ apply Hsim.
++ reflexivity.
diff --git a/CaseStudies/Gathering/WithMultiplicity.v b/CaseStudies/Gathering/WithMultiplicity.v
index a9903825a3fc4c8b636f2e7e2d44c5de09abb485..e2ca236592e232f6827194b0e38375bcf0b23bb3 100644
--- a/CaseStudies/Gathering/WithMultiplicity.v
+++ b/CaseStudies/Gathering/WithMultiplicity.v
@@ -27,7 +27,7 @@ Close Scope R_scope.
Close Scope VectorSpace_scope.
Set Implicit Arguments.
Typeclasses eauto := (bfs) 5.
-Require Even.
+(* Require Even. *)
(** Gathering Definitions specific to a setting with multiplicities, i.e. a multiset observation. *)
@@ -36,7 +36,7 @@ Section MultisetGathering.
(** Here, we restrict the state to only contain the location. *)
Context `{Location}.
(* TODO: add the existence of a similarity here *)
-Instance Info : State location := OnlyLocation (fun _ => True).
+#[export]Instance Info : State location := OnlyLocation (fun _ => True).
Context {VS : RealVectorSpace location}.
Context {RMS : RealMetricSpace location}.
Context `{Names}.
@@ -46,7 +46,7 @@ Context `{inactive_choice}.
Context {UpdFun : update_function _ _ _}.
Context {InaFun : inactive_function _}.
-Global Existing Instance multiset_observation.
+#[export] Existing Instance multiset_observation.
Notation "!! config" :=
(@obs_from_config location _ _ _ multiset_observation config origin : observation) (at level 10).
@@ -102,12 +102,12 @@ rewrite <- (@cardinal_total_sub_eq _ _ _ _ _ (add pt2 (Nat.div2 nG) (singleton p
+ rewrite size_add.
destruct (In_dec pt2 (singleton pt1 (Nat.div2 nG))) as [Hin | Hin].
- exfalso. rewrite In_singleton in Hin.
- destruct Hin. now elim Hdiff.
+ destruct Hin. now contradiction Hdiff.
- rewrite size_singleton; trivial; [].
apply Exp_prop.div2_not_R0. apply HsizeG.
- apply Exp_prop.div2_not_R0. apply HsizeG.
+ intro pt. destruct (pt =?= pt2) as [Heq2 | Heq2], (pt =?= pt1) as [Heq1 | Heq1].
- - rewrite Heq1, Heq2 in *. now elim Hdiff.
+ - rewrite Heq1, Heq2 in *. now contradiction Hdiff.
- rewrite add_spec, singleton_spec.
do 2 destruct_match; try contradiction; [].
simpl.
@@ -143,12 +143,12 @@ destruct Hconfig as [Heven [Hge2 [pt1' [pt2' [Hdiff [Hpt1' Hpt2']]]]]].
assert (Hcase : pt1' == pt1 /\ pt2' == pt2 \/ pt1' == pt2 /\ pt2' == pt1).
{ assert (Hin1 : InA equiv pt1' (pt1 :: pt2 :: nil)).
{ rewrite <- Hsupp, support_spec. unfold In. rewrite Hpt1'.
- destruct nG as [| [| nG]]; simpl; lia. }
+ destruct nG as [| [| nG]]; simpl; solve [ auto with arith | lia]. }
assert (Hin2 : InA equiv pt2' (pt1 :: pt2 :: nil)).
{ rewrite <- Hsupp, support_spec. unfold In. rewrite Hpt2'.
- destruct nG as [| [| nG]]; simpl; lia. }
+ destruct nG as [| [| nG]]; simpl; solve [ auto with arith | lia]. }
rewrite 2 InA_cons, InA_nil in Hin1, Hin2. clear -Hin1 Hin2 Hdiff.
- decompose [or] Hin1; decompose [or] Hin2; tauto || elim Hdiff; etransitivity; eauto. }
+ decompose [or] Hin1; decompose [or] Hin2; tauto || contradiction Hdiff; etransitivity; eauto. }
split.
+ intro. apply Hdiff.
decompose [and or] Hcase; repeat (etransitivity; eauto; symmetry).
@@ -158,7 +158,7 @@ split.
destruct Hcase as [[Heq1 Heq2] | [Heq1 Heq2]];
rewrite Heq1 in *; rewrite Heq2 in *;
try match goal with H : pt == _ |- _ => rewrite H in *; clear H end;
- rewrite ?Hpt1', ?Hpt2'; lia || now elim Hdiff.
+ rewrite ?Hpt1', ?Hpt2'; lia || now contradiction Hdiff.
- rewrite cardinal_add, cardinal_singleton, cardinal_obs_from_config, even_div2; auto; lia.
Qed.
@@ -171,8 +171,8 @@ destruct (invalid_strengthen HnB Hinvalid) as [pta [ptb Hdiff Hobs]].
rewrite Hobs, add_In, In_singleton in Hin1, Hin2, Hin3.
destruct Hin1 as [[] | []], Hin2 as [[] | []], Hin3 as [[] | []];
solve [ etransitivity; eauto
- | elim Hdiff13; etransitivity; eauto
- | elim Hdiff23; etransitivity; eauto ].
+ | contradiction Hdiff13; etransitivity; eauto
+ | contradiction Hdiff23; etransitivity; eauto ].
Qed.
Arguments invalid_same_location _ config {pt1} {pt2} pt3 _ _ _ _ _.
@@ -210,9 +210,9 @@ destruct (n1 =?= n2) as [Hn | Hn].
eapply proj1. rewrite <- elements_spec.
rewrite Helem. now right; left.
* right.
- intro Hvalid. elim Hn.
+ intro Hvalid. contradiction Hn.
assert (Hhalf : 0 < Nat.div2 nG).
- { destruct Hvalid as [_ [Hle _]]. destruct nG as [| [| ?]]; simpl; lia. }
+ { destruct Hvalid as [_ [Hle _]]. destruct nG as [| [| ?]]; simpl; solve [ auto with arith | lia]. }
destruct (invalid_strengthen HnB Hvalid) as [pt1' [pt2' Hdiff Hobs]].
assert (Hperm : PermutationA eq_pair ((pt1, n1) :: (pt2, n2) :: nil)
((pt1', Nat.div2 nG) :: (pt2', Nat.div2 nG) :: nil)).
@@ -221,7 +221,7 @@ destruct (n1 =?= n2) as [Hn | Hn].
constructor.
+ split; simpl; reflexivity || lia.
+ destruct_match.
- - elim Hdiff. hnf in * |-; simpl in *. auto.
+ - contradiction Hdiff. hnf in * |-; simpl in *. auto.
- reflexivity. }
rewrite PermutationA_2 in Hperm; autoclass; [].
clear -Hperm. destruct Hperm as [[[] []] | [[] []]]; compute in *; congruence.
diff --git a/CaseStudies/Gathering/WithMultiplicityLight.v b/CaseStudies/Gathering/WithMultiplicityLight.v
index 1bb092f2767704a6604ad806fe25d89ade81ad23..bfdca76e9997a920432b530057fe0e03e92ff8d0 100644
--- a/CaseStudies/Gathering/WithMultiplicityLight.v
+++ b/CaseStudies/Gathering/WithMultiplicityLight.v
@@ -21,7 +21,8 @@
Require Import Utf8.
Require Import Lia PeanoNat.
-Require Import SetoidList.
+Require Import SetoidList Pactole.Util.SetoidDefs.
+Require Import Pactole.Util.Bijection.
Require Export Pactole.CaseStudies.Gathering.Definitions.
Require Export Pactole.Observations.MultisetObservation.
Require Import Pactole.Observations.PairObservation.
@@ -29,17 +30,11 @@ Close Scope R_scope.
Close Scope VectorSpace_scope.
Set Implicit Arguments.
Typeclasses eauto := (bfs) 5.
-Require Even.
-
-Local Existing Instance fst_compat_pactole.
-Local Existing Instance snd_compat_pactole.
-Local Existing Instance pair_compat_pactole.
-
Class Lights := {
L : Type;
- L_Setoid :> Setoid L;
- L_EqDec :> EqDec L_Setoid;
+ #[export] L_Setoid :: Setoid L;
+ #[export] L_EqDec :: EqDec L_Setoid;
witness : L;
l_list : list L;
L_list_NoDupA : NoDupA equiv l_list;
@@ -120,7 +115,7 @@ rewrite config_list_map, map_map.
- apply Hf_inj in H. contradiction.
- rewrite H0 in *. intuition.
- reflexivity.
-* apply lift_compat. intros x y Hxy. cbn. now apply Hf.
+(* * apply lift_compat. intros x y Hxy. cbn. now apply Hf. *)
Qed.
Existing Instance eqlistA_Setoid.
@@ -204,6 +199,8 @@ Proof.
assert (Hfst := Hconfig').
apply (hd_eqlistA_compat _ _ Hstate), fst_compat_pactole in Hfst.
red.
+ (* apply (hd_eqlistA_compat _ _ Hstate), fst_compat_pactole in Hfst. *)
+ (* red. *)
unfold obsLight_Setoid.
cbn -[fst] in Hstate.
destruct Hstate as [h1 h2].
@@ -225,14 +222,16 @@ Proof.
change (f (fst st), snd st) with (lift (existT _ f I) st).
assert (Proper (equiv (A := location * L) ==> equiv (A := location * L))
(lift (existT precondition f I))) as h_proper.
- { intros ? ? ?. now apply lift_compat. }
+ { intros ? ? ?.
+ now apply (@lift_compat _ _ St). }
unfold obs_from_config2. rewrite config_list_map; trivial; [].
cbn -[equiv].
intros h_eq_obs h_eq_obsf.
split; cbn -[equiv].
- now rewrite h_eq_obs, h_eq_obsf.
- - rewrite h_eq_obs, h_eq_obsf.
- cbn -[equiv].
+ - rewrite h_eq_obsf, h_eq_obs.
+ cbn.
+ intros x.
now rewrite make_multiset_map.
Qed.
@@ -415,8 +414,8 @@ intros f Hf Hf_inj Pf config st. split.
now rewrite Hmap.
* do 2 (unfold obs_from_config; cbn -[equiv]).
split.
- - specialize obs_from_config2_map as h.
- specialize h with (f:=f) (config:=config) (st:=st).
+ - specialize (@obs_from_config2_map f) as h.
+ specialize h with (config:=config) (st:=st).
edestruct h;auto.
- reflexivity.
Qed.
@@ -564,9 +563,9 @@ assert (Hn : (!! config)[pt1] + (!! config)[pt2] = nG + nB).
+ intros ? ? Heq1 ? ? Heq2. now rewrite Heq1, Heq2.
+ intros. hnf. lia. }
assert (Heven : Nat.Even (nG + nB)).
-{ rewrite <- Hn, Hsame, <- Even.even_equiv.
+{ rewrite <- Hn, Hsame (*, <- Even.even_equiv*).
replace ((!! config)[pt2] + (!! config)[pt2]) with (2 * (!! config)[pt2]) by lia.
- apply Even.even_mult_l. repeat constructor. }
+ now exists (!! config)[pt2]. }
repeat split.
* assumption.
* rewrite <- Hn, <- Hsame. cut ((!! config)[pt1] > 0); try lia; [].
@@ -574,9 +573,9 @@ repeat split.
* exists pt1, pt2. repeat split.
+ assert (Hnodup := support_NoDupA (!! config)).
now rewrite Hperm, NoDupA_2 in Hnodup.
- + rewrite <- Even.even_equiv in Heven. apply Div2.even_double in Heven.
+ + apply Nat.Even_double in Heven.
rewrite <- Hsame in Hn. unfold Nat.double in *. rewrite <- Hn in Heven at 1. lia.
- + rewrite <- Even.even_equiv in Heven. apply Div2.even_double in Heven.
+ + apply Nat.Even_double in Heven.
rewrite Hsame in Hn. unfold Nat.double in *. rewrite <- Hn in Heven at 1. lia.
Qed.
@@ -737,7 +736,7 @@ destruct (support obs) as [| e1 [| e2 [| e3 ?]]] eqn:Hsupport.
rewrite <- Hequiv, Hpt1, Hpt2 in Hcard.
assert (obs[pt] > 0).
{ change (In pt obs). rewrite <- support_spec, Hsupp, 3 InA_cons. clear. intuition. }
- rewrite <- Even.even_equiv in Heven. apply Div2.even_double in Heven.
+ apply Nat.Even_double in Heven.
unfold Nat.double in *. lia.
Qed.
@@ -893,7 +892,7 @@ Proof.
rewrite H0 at 2.
change (Bijection.retraction f (f x)) with ((λ x0 : location, Bijection.retraction f (f x0)) x).
rewrite map_injective_spec;auto. }
- apply EqNat.beq_nat_true in h_bivopsmap.
+ apply Nat.eqb_eq in h_bivopsmap.
apply Nat.eqb_eq.
destruct (PermutationA_2_gen _ h_permut) as [ a [b [[[heq_a heq_b] | [heq_a heq_b]] h_map]]].
- inversion h_map.
@@ -946,7 +945,7 @@ Proof.
+ cbn.
repeat rewrite Hext.
repeat rewrite Bool.andb_assoc.
- setoid_rewrite Bool.andb_comm at 2.
+ rewrite (Bool.andb_comm (g y) (g x)).
rewrite permut_forallb_ext with (g:=g);auto.
+ transitivity (forallb g lâ‚‚);auto.
rewrite permut_forallb_ext with (g:=f);auto.
@@ -1184,12 +1183,16 @@ assert (Hcase : pt1' == pt1 /\ pt2' == pt2 \/ pt1' == pt2 /\ pt2' == pt1).
{ rewrite <- Hsupp, support_spec. unfold In.
rewrite hfst.
rewrite Hpt1'.
- destruct (nG+nB) as [| [| nG]] eqn:heqnB ; simpl; lia. }
+ destruct (nG+nB) as [| [| nG]] eqn:heqnB ; simpl; try lia.
+ set (d := (Nat.div2 nG)).
+ lia. }
assert (Hin2 : InA equiv pt2' (pt1 :: pt2 :: nil)).
{ rewrite <- Hsupp, support_spec. unfold In.
rewrite hfst.
rewrite Hpt2'.
- destruct (nG+nB) as [| [| nG]] eqn:heqnB; simpl; lia. }
+ destruct (nG+nB) as [| [| nG]] eqn:heqnB; simpl; try lia.
+ set (d := (Nat.div2 nG)).
+ lia. }
rewrite 2 InA_cons, InA_nil in Hin1, Hin2. clear -Hin1 Hin2 Hdiff.
decompose [or] Hin1; decompose [or] Hin2; tauto || elim Hdiff; etransitivity; eauto. }
split.
@@ -1341,8 +1344,6 @@ Proof.
reflexivity.
Qed.
-Local Existing Instance Pactole.Util.FMaps.FMapInterface.prod_Setoid.
-Local Existing Instance Pactole.Util.FMaps.FMapInterface.prod_EqDec.
#[export]
Instance pair_compat_ours {A B} {SA : Setoid A} {SB : Setoid B}: Proper (equiv ==> equiv ==> equiv) (@pair A B).
Proof.
@@ -1587,7 +1588,7 @@ Property state_in_config : forall config pt id, In (config id) (colors (snd (Obs
Proof.
intros config pt id. unfold obs_from_config. simpl. unfold In.
rewrite make_multiset_spec. rewrite (countA_occ_pos _).
-change (@FMapInterface.prod_Setoid (@location Loc) (@L Lght) (@location_Setoid Loc) (@L_Setoid Lght))
+change (@prod_Setoid (@location Loc) (@L Lght) (@location_Setoid Loc) (@L_Setoid Lght))
with (@state_Setoid _ (prod (@location Loc) (@L Lght)) _).
rewrite (config_list_InA (config id) config). now exists id.
Qed.
diff --git a/CaseStudies/LifeLine/Algorithm.v b/CaseStudies/LifeLine/Algorithm.v
index 3baaa3337d2781f179547be533ed8810d7cb97b0..02b9fc67112ff43d8856bc9f68cd56f72d7608ba 100644
--- a/CaseStudies/LifeLine/Algorithm.v
+++ b/CaseStudies/LifeLine/Algorithm.v
@@ -1,6 +1,6 @@
Require Import Utf8.
Require Import Bool.
-Require Import Arith.Div2 Lia Field.
+Require Import Lia Field.
Require Import Rbase Rbasic_fun R_sqrt Rtrigo_def Lra.
Require Import List SetoidList SetoidDec.
Require Import Relations RelationPairs Morphisms.
@@ -14,6 +14,7 @@ Require Import Pactole.Spaces.R2.
Require Import Pactole.Spaces.Isometry.
Require Import Pactole.Models.Rigid.
Require Import Pactole.Models.Isometry.
+Require Import Pactole.Util.Fin.
Import Permutation.
Import Datatypes. (* to recover [id] *)
Close Scope VectorSpace_scope.
@@ -35,12 +36,15 @@ Variable n: nat.
(** All robots are non byzantine, except the scout
(considered as a Byzantine as it does not follow the protocol) *)
Instance Identifiers : Names := Robots n 1.
-Definition scout_B : B := exist _ 0%nat (le_n 1).
+Definition scout_B : B := Fin Nat.lt_0_1.
Definition scout : ident := Byz scout_B.
(** The only Byzantine robot is the scout. *)
-Lemma byz_is_scout : forall b : B, b = scout_B.
-Proof using . intros [[] Hb]; try lia; []. unfold scout_B. f_equal. apply le_unique. Qed.
+Lemma byz_is_scout : ∀ b : B, b = scout_B.
+Proof using .
+ intros [b Hb]. change B with (fin 1) in *. apply fin2natI. cbn.
+ destruct b as [|b]. reflexivity. inv Hb. inv H0.
+Qed.
(** The space is the Euclidean plane *)
Instance Loc : Location := make_Location R2.
@@ -86,7 +90,7 @@ Instance state_Setoid : Setoid state := {
Proof using . split.
+ intros []; hnf; repeat split.
+ intros []; hnf; repeat split; symmetry; intuition.
-+ intros []; hnf; repeat split; simpl in *; etransitivity; intuition; congruence.
++ intros []; hnf; repeat split; simpl in *; etransitivity; intuition auto; congruence.
Defined.
#[refine]
@@ -339,8 +343,8 @@ Class Param := {
(* where to go to follow the target? *)
choose_new_pos : observation -> location -> location;
(* Compatibility properties *)
- choose_target_compat :> Proper (equiv ==> equiv) choose_target;
- choose_new_pos_compat :> Proper (equiv ==> equiv ==> equiv) choose_new_pos;
+ choose_target_compat : Proper (equiv ==> equiv) choose_target;
+ choose_new_pos_compat : Proper (equiv ==> equiv ==> equiv) choose_new_pos;
(* Specifications *)
choose_target_spec : forall obs,
obs =/= {}%set ->
@@ -358,6 +362,10 @@ Class Param := {
let new := choose_new_pos obs pt in
dist new pt <= Dp /\ dist new origin <= D }.
+Global Existing Instance choose_target_compat.
+Global Existing Instance choose_new_pos_compat.
+
+
(** Is it safe to move? *)
Definition move_to obs pt :=
negb (exists_ (fun x => Rle_bool (dist (tgt_loc x) pt) (2*D)) obs).
@@ -378,7 +386,7 @@ Proof using .
intros obs pt. rewrite <- not_false_iff_true, move_to_false. split; intro Hspec.
+ intros tgt Hin. destruct (Rlt_le_dec (2*D) (dist (tgt_loc tgt) pt)) as [Hlt | Hle].
- assumption.
- - elim Hspec. now exists tgt.
+ - contradiction Hspec. now exists tgt.
+ intros [tgt [Hin Habs]]. apply Hspec in Hin.
apply (Rlt_irrefl (2*D)). eapply Rlt_le_trans; eauto.
Qed.
@@ -428,8 +436,8 @@ intros obs pt. rewrite <- not_true_iff_false, should_die_true. split; intro Hspe
+ split; try (now exists elt; apply choose_1); [].
intros tgt Hin. destruct (Rlt_le_dec D (dist (tgt_loc tgt) pt)) as [Hlt | Hle].
- assumption.
- - elim Hspec. right. now exists tgt.
- + elim Hspec. left. intro x. apply choose_2 in Hchoose. specialize (Hchoose x).
+ - contradiction Hspec. right. now exists tgt.
+ + contradiction Hspec. left. intro x. apply choose_2 in Hchoose. specialize (Hchoose x).
split; intro Habs.
- contradiction.
- now apply empty_spec in Habs.
@@ -534,7 +542,7 @@ split.
- unfold obs in Hin. rewrite obs_from_config_spec in Hin.
destruct Hin as [r [Heq [Halive' [Hdist Hid]]]].
exists r. now repeat split.
- - elim Halive. intro x. rewrite empty_spec. split; tauto || apply Hempty.
+ - contradiction Halive. intro x. rewrite empty_spec. split; tauto || apply Hempty.
Qed.
Lemma connected_path_iso_compat :
@@ -642,7 +650,7 @@ Lemma update_simplify : forall da, da_assumption da ->
Proof using .
intros da Hda config Hpath g Hg new_frame local_config local_state obs.
destruct (Rle_dec (dist (choose_new_pos obs (tgt_loc (choose_target obs))) 0) D); eauto; [].
-revert_one not. intro Habs. elim Habs.
+revert_one not. intro Habs. contradiction Habs.
assert (Hobs : obs =/= {}%set).
{ rewrite connected_path_iff_obs_non_empty in Hpath. apply Hpath in Hg. unfold complement in *.
cbn -[equiv] in Hg.
@@ -1002,10 +1010,10 @@ intros [g | b] Halive Hmoving.
* unfold config' in *. simplify_round.
destruct (rbg obs).
+ cbn in Halive. discriminate.
- + cbn -[equiv] in Hmoving. elim Hmoving. apply retraction_section.
+ + cbn -[equiv] in Hmoving. contradiction Hmoving. apply retraction_section.
+ cbn -[equiv] in Hmoving |- *. destruct_match.
- reflexivity.
- - elim Hmoving. cbn. now rewrite simpl_inverse_l.
+ - contradiction Hmoving. cbn. now rewrite simpl_inverse_l.
* rewrite (byz_is_scout b). apply scout_invariant in scout_has_inv.
destruct scout_has_inv as [pt Hpt]. now rewrite Hpt.
Qed.
@@ -1065,7 +1073,7 @@ Lemma no_collision_invariant : connected_path config ->
Proof using D_pos Dmax_6D Hda id_uniq scout_has_inv.
intros Hpath Hcollision r r' Hdiff.
pattern r, r'.
-match goal with |- ?P _ _ => assert (Hsym : forall r r', P r r' ↔ P r' r) by intuition end.
+match goal with |- ?P _ _ => assert (Hsym : forall r r', P r r' ↔ P r' r) by (intuition auto with *) end.
cbn beta. apply (wlog_lt_id _ Hsym); trivial; []. clear r r' Hdiff Hsym.
intros r r' Hlt Halive Halive' Heq'.
(* The robot with highest id cannot be the scout. *)
@@ -1640,7 +1648,7 @@ Qed.
Lemma fold_indep_elt : forall s e1 e2, (e1 ∈ s)%set -> (e2 ∈ s)%set ->
fold (fun e min => if lt_dec e min then e else min) s e1
== fold (fun e min => if lt_dec e min then e else min) s e2.
-Proof.
+Proof using trichotomy lt_compat St.
intros s e1 e2 He1 He2.
destruct (fold_min_spec s e1) as [Hin1 [Hmin1 Hall1]],
(fold_min_spec s e2) as [Hin2 [Hmin2 Hall2]].
@@ -1732,7 +1740,7 @@ Definition tgt_lt x y :=
\/ tgt_loc x == tgt_loc y /\ tgt_light x = true /\ tgt_light y = false.
Definition tgt_lt_dec : forall x y, {tgt_lt x y} + {~tgt_lt x y}.
-Proof.
+Proof using .
intros x y. unfold tgt_lt.
destruct (Rlt_dec (fst (tgt_loc x)) (fst (tgt_loc y))).
* now do 2 left.
@@ -1746,10 +1754,10 @@ destruct (Rlt_dec (fst (tgt_loc x)) (fst (tgt_loc y))).
Defined.
Instance tgt_lt_compat : Proper (equiv ==> equiv ==> iff) tgt_lt.
-Proof. intros [] [] [] [] [] []. simpl in *. now subst. Qed.
+Proof using. intros [] [] [] [] [] []. simpl in *. now subst. Qed.
Instance tgt_lt_SO : StrictOrder tgt_lt.
-Proof. split.
+Proof using. split.
+ unfold tgt_lt. intros x Habs. decompose [and or] Habs; clear Habs; try congruence; [|];
eapply (@irreflexivity _ Rlt); eauto; autoclass.
+ unfold tgt_lt. intros x y z Hlt1 Hlt2.
@@ -1783,7 +1791,7 @@ Local Hint Immediate tgt_trichotomy : core.
Definition choose_min := set_min tgt_lt tgt_lt_dec.
Instance choose_min_compat : Proper (equiv ==> equiv) choose_min.
-Proof. repeat intro. unfold choose_min. apply set_min_compat; autoclass. Qed.
+Proof using. repeat intro. unfold choose_min. apply set_min_compat; autoclass. Qed.
#[refine]
Instance concrete_params : Param := {|
diff --git a/Core/Configuration.v b/Core/Configuration.v
index 8d96bf90c13d6583ace940cdb44b0620d80512f7..56b19886fb3f0f34182a7cf92a918208ab63d5dd 100644
--- a/Core/Configuration.v
+++ b/Core/Configuration.v
@@ -16,6 +16,7 @@
This file is distributed under the terms of the CeCILL-C licence *)
+Require Import Utf8.
Require Import SetoidList.
Require Import SetoidDec.
Require Import Decidable.
@@ -38,61 +39,56 @@ Context `{State}.
Context `{Names}.
(** Equality of configurations is extensional. *)
-Global Instance configuration_Setoid : Setoid configuration := fun_equiv ident _.
+Global Instance configuration_Setoid : Setoid configuration := fun_Setoid ident _.
Global Instance configuration_compat : forall config : configuration, Proper (Logic.eq ==> equiv) config.
Proof using . repeat intro. now subst. Qed.
+Open Scope program_scope.
+
(** The lists of positions for good, Byzantine, and all robots. *)
-Definition Gpos := fun config : configuration => List.map (fun g => config (Good g)) Gnames.
-Definition Bpos := fun config : configuration => List.map (fun b => config (Byz b)) Bnames.
+Definition Gpos := fun config : configuration => List.map (config ∘ Good) Gnames.
+Definition Bpos := fun config : configuration => List.map (config ∘ Byz) Bnames.
Definition config_list := fun config => Gpos config ++ Bpos config.
-Lemma Gpos_spec : forall config, Gpos config = List.map (fun g => config (Good g)) Gnames.
+Lemma Gpos_spec : forall config, Gpos config = List.map (config ∘ Good) Gnames.
Proof using . reflexivity. Qed.
-Lemma Bpos_spec : forall config, Bpos config = List.map (fun g => config (Byz g)) Bnames.
+Lemma Bpos_spec : forall config, Bpos config = List.map (config ∘ Byz) Bnames.
Proof using . reflexivity. Qed.
+Close Scope program_scope.
+
Lemma config_list_spec : forall config, config_list config = List.map config names.
Proof using . intros. unfold config_list, names. rewrite map_app. now do 2 rewrite map_map. Qed.
(** Compatilities with equivalences. *)
Global Instance Gpos_compat : Proper (@equiv _ configuration_Setoid ==> eqlistA equiv) Gpos.
-Proof using .
-intros f g Hfg. eapply map_extensionalityA_compat; reflexivity || autoclass; [].
-intros x y Hxy. cbn in Hxy. subst. apply Hfg.
-Qed.
+Proof using . intros f g Hfg. rewrite 2Gpos_spec, Hfg. reflexivity. Qed.
Global Instance Bpos_compat : Proper (@equiv _ configuration_Setoid ==> eqlistA equiv) Bpos.
-Proof using .
-intros f g Hfg. eapply map_extensionalityA_compat; reflexivity || autoclass; [].
-intros x y Hxy. cbn in Hxy. subst. apply Hfg.
-Qed.
+Proof using . intros f g Hfg. rewrite 2Bpos_spec, Hfg. reflexivity. Qed.
Global Instance config_list_compat : Proper (@equiv _ configuration_Setoid ==> eqlistA equiv) config_list.
-Proof using .
-intros f g Hfg. rewrite 2 config_list_spec. f_equiv.
-intros x y Hxy. cbn in Hxy. subst. apply Hfg.
-Qed.
+Proof using . intros f g Hfg. rewrite 2config_list_spec, Hfg. reflexivity. Qed.
(** Properties w.r.t. [InA] and [length]. *)
Lemma Gpos_InA : forall l config, InA equiv l (Gpos config) <-> exists g, equiv l (config (Good g)).
Proof using .
-intros. rewrite Gpos_spec, InA_map_iff; autoclass; [|].
-+ split; intros [g Hg]; exists g.
+intros. rewrite Gpos_spec, InA_map_iff; autoclass;
+try (now repeat intro; cbn in *; now subst); []. (* for 8.16 and 8.17 *)
+split; intros [g Hg]; exists g.
- now symmetry.
- split; try (now symmetry); []. rewrite InA_Leibniz. apply In_Gnames.
-+ repeat intro. cbn in *. now subst.
Qed.
Lemma Bpos_InA : forall l config, InA equiv l (Bpos config) <-> exists b, equiv l (config (Byz b)).
Proof using .
-intros. rewrite Bpos_spec, InA_map_iff; autoclass; [|].
-+ split; intros [b Hb]; exists b.
+intros. rewrite Bpos_spec, InA_map_iff; autoclass;
+try (now repeat intro; cbn in *; now subst); []. (* for 8.16 and 8.17 *)
+split; intros [b Hb]; exists b.
- now symmetry.
- split; try (now symmetry); []. rewrite InA_Leibniz. apply In_Bnames.
-+ repeat intro. cbn in *. now subst.
Qed.
Lemma config_list_InA : forall l config, InA equiv l (config_list config) <-> exists id, equiv l (config id).
@@ -138,7 +134,7 @@ intros configâ‚ configâ‚‚. split; intro Hneq.
- inversion Hin.
- inversion_clear Habs. inversion_clear Hin; solve [now subst | now apply IHl]. }
induction names as [| id l].
- - now elim Hlist.
+ - now contradiction Hlist.
- cbn in Hlist. destruct (equiv_dec (configâ‚ id) (configâ‚‚ id)) as [Hid | Hid].
-- apply IHl. intro Heq. apply Hlist. now constructor.
-- eauto.
@@ -212,40 +208,6 @@ Qed.
End Configuration.
-(** Applying a function on all states of a configuration. *)
-
-Section MapConfig.
-
-Context `{Location}.
-Context {info1 info2 : Type}.
-Context {St1 : @State _ info1}.
-Context {St2 : @State _ info2}.
-Context `{Names}.
-
-Definition map_config (f : info1 -> info2) (config : @configuration _ _ St1 _) : configuration :=
- fun id => f (config id).
-
-Global Instance map_config_compat :
- Proper ((equiv ==> equiv) ==> @equiv _ configuration_Setoid ==> @equiv _ configuration_Setoid) map_config.
-Proof using . intros f g Hfg ? ? Hconfig id. unfold map. apply Hfg, Hconfig. Qed.
-
-Lemma config_list_map : forall f, Proper (equiv ==> equiv) f ->
- forall config, config_list (map_config f config) == List.map f (config_list config).
-Proof using . intros. now rewrite 2 config_list_spec, map_map. Qed.
-
-End MapConfig.
-
-Arguments map_config {_} {info1} {info2} {_} {_} {_} f config id /.
-
-Lemma map_config_id `{State} `{Names} : forall config,
- map_config Datatypes.id config == config.
-Proof using . now repeat intro. Qed.
-
-Lemma map_config_merge `{Location} {T U V : Type} `{@State _ T} `{@State _ U} `{@State _ V} `{Names} :
- forall (f : T -> U) (g : U -> V), Proper (equiv ==> equiv) f -> Proper (equiv ==> equiv) g ->
- forall config : configuration, map_config g (map_config f config) == map_config (fun x => g (f x)) config.
-Proof using . now repeat intro. Qed.
-
(** Injective configurations *)
Definition config_injective `{State} `{Names} :=
Util.Preliminary.injective (@eq ident) (@equiv _ state_Setoid).
@@ -296,3 +258,46 @@ intros config. split; intro Hinj.
rewrite <- NoDupA_Leibniz, Hnames in Hnodup. inversion_clear Hnodup. subst. tauto.
+ destruct Hinj as [id [id' [Hid Heq]]]. intro Habs. apply Habs in Heq. contradiction.
Qed.
+
+(** Applying a function on all states of a configuration. *)
+
+Section MapConfig.
+
+Context {L : Location} {info1 info2 : Type}.
+Context {St1 : @State _ info1} {St2 : @State _ info2}.
+Context {N : Names}.
+
+Definition map_config (f : info1 -> info2) (config : @configuration _ _ St1 _) : configuration :=
+ fun id => f (config id).
+
+Global Instance map_config_compat :
+ Proper ((equiv ==> equiv) ==> @equiv _ configuration_Setoid ==> @equiv _ configuration_Setoid) map_config.
+Proof using . intros f g Hfg ? ? Hconfig id. unfold map. apply Hfg, Hconfig. Qed.
+
+Lemma config_list_map : forall f config,
+ config_list (map_config f config) == List.map f (config_list config).
+Proof using . intros. now rewrite 2 config_list_spec, map_map. Qed.
+
+Lemma map_config_inj' : ∀ (f : info1 -> info2),
+ Preliminary.injective equiv equiv f -> Preliminary.injective equiv equiv (map_config f).
+Proof using . intros f H config1 config2 Hc id. apply H, Hc. Qed.
+
+Lemma map_config_inj : ∀ (f : info1 -> info2) (config : @configuration _ _ St1 _),
+ Preliminary.injective equiv equiv f -> config_injective config
+ -> config_injective (map_config f config).
+Proof using .
+ unfold map_config. intros * Hf Hc id1 id2 Hm. apply Hc, Hf, Hm.
+Qed.
+
+End MapConfig.
+
+Arguments map_config {_} {info1} {info2} {_} {_} {_} f config id /.
+
+Lemma map_config_id `{State} `{Names} : forall config,
+ map_config Datatypes.id config == config.
+Proof using . now repeat intro. Qed.
+
+Lemma map_config_merge `{Location} {T U V : Type} `{@State _ T} `{@State _ U} `{@State _ V} `{Names} :
+ forall (f : T -> U) (g : U -> V), Proper (equiv ==> equiv) g ->
+ forall config : configuration, map_config g (map_config f config) == map_config (fun x => g (f x)) config.
+Proof using . now repeat intro. Qed.
diff --git a/Core/Formalism.v b/Core/Formalism.v
index 839abd9d2ea98e017eab27f96c332d13b9046299..30c0cd6db0479fc91ec35418ac14514a933f138d 100644
--- a/Core/Formalism.v
+++ b/Core/Formalism.v
@@ -30,6 +30,8 @@ Require Import Pactole.Core.State.
Require Import Pactole.Core.Configuration.
Require Import Pactole.Observations.Definition.
+(* this will become non default soon. *)
+Ltac Tauto.intuition_solver ::= auto with *.
Typeclasses eauto := 5.
Remove Hints eq_setoid : typeclass_instances.
@@ -52,11 +54,11 @@ Definition execution := Stream.t configuration.
(** Good robots have a common program, which we call a [robogram].
It returns some piece of information (e.g. target location) which must form a setoid. *)
-Class robot_choice := { robot_choice_Setoid :> Setoid Trobot }.
+Class robot_choice := { #[global] robot_choice_Setoid :: Setoid Trobot }.
Record robogram `{robot_choice} := {
pgm :> observation -> Trobot;
- pgm_compat :> Proper (equiv ==> equiv) pgm}.
+ #[global] pgm_compat :: Proper (equiv ==> equiv) pgm}.
Global Instance robogram_Setoid `{robot_choice} : Setoid robogram.
simple refine {| equiv := fun r1 r2 => forall s, pgm r1 s == pgm r2 s |};
@@ -88,28 +90,28 @@ Qed.
It must at least contain a bijection to compute the change of frame of reference. *)
Class frame_choice := {
frame_choice_bijection : Tframe -> bijection location;
- frame_choice_Setoid :> Setoid Tframe;
- frame_choice_bijection_compat :> Proper (equiv ==> equiv) frame_choice_bijection }.
+ #[global] frame_choice_Setoid :: Setoid Tframe;
+ #[global] frame_choice_bijection_compat :: Proper (equiv ==> equiv) frame_choice_bijection }.
(** An [update_choice] represents the choices the demon makes after a robot computation. *)
Class update_choice := {
- update_choice_Setoid :> Setoid Tactive;
- update_choice_EqDec :> EqDec update_choice_Setoid }.
+ #[global] update_choice_Setoid :: Setoid Tactive;
+ #[global] update_choice_EqDec :: EqDec update_choice_Setoid }.
(** An [inactive_choice] represents the choices the demon makes when a robot is not activated. *)
Class inactive_choice := {
- inactive_choice_Setoid :> Setoid Tinactive;
- inactive_choice_EqDec :> EqDec inactive_choice_Setoid }.
+ #[global] inactive_choice_Setoid :: Setoid Tinactive;
+ #[global] inactive_choice_EqDec :: EqDec inactive_choice_Setoid }.
(** These choices are then used by update functions that depend on the model. *)
(* RMK: we cannot combine them toghether otherwise we get dependencies on the other parameter. *)
Class update_function `{robot_choice} `{frame_choice} `{update_choice} := {
update : configuration -> G -> Tframe -> Trobot -> Tactive -> info;
- update_compat :> Proper (equiv ==> Logic.eq ==> equiv ==> equiv ==> equiv ==> equiv) update }.
+ #[global] update_compat :: Proper (equiv ==> Logic.eq ==> equiv ==> equiv ==> equiv ==> equiv) update }.
Class inactive_function `{inactive_choice} := {
inactive : configuration -> ident -> Tinactive -> info;
- inactive_compat :> Proper (equiv ==> Logic.eq ==> equiv ==> equiv) inactive }.
+ #[global] inactive_compat :: Proper (equiv ==> Logic.eq ==> equiv ==> equiv) inactive }.
Context {RC : robot_choice}.
Context {FC : frame_choice}.
@@ -434,10 +436,10 @@ induction names as [| id l]; simpl.
destruct (round r1 da1 c1 id =?= c1 id) as [Heq1 | Heq1],
(round r2 da2 c2 id =?= c2 id) as [Heq2 | Heq2]; cbn.
+ apply IHl.
- + elim Heq2. transitivity (round r1 da1 c1 id).
+ + contradiction Heq2. transitivity (round r1 da1 c1 id).
- symmetry. now apply round_compat.
- rewrite Heq1. apply Hc.
- + elim Heq1. transitivity (round r2 da2 c2 id).
+ + contradiction Heq1. transitivity (round r2 da2 c2 id).
- now apply round_compat.
- rewrite Heq2. symmetry. apply Hc.
+ f_equal. apply IHl.
@@ -680,12 +682,13 @@ Proof using . intros k ??. subst. apply Stream.forever_compat. intros ?? Heq. no
(** A k-fair demon is fair. *)
Lemma Between_eventually_activated : forall id (d : demon) id' k,
Between id id' d k -> Stream.eventually (Stream.instant (fun da => activate da id = true)) d.
-Proof using . intros * Hg. induction Hg; now constructor; trivial; firstorder. Qed.
+Proof using . intros * Hg. induction Hg; constructor; assumption. Qed.
Theorem kFair_Fair : forall k (d : demon), kFair k d -> Fair d.
Proof using .
intro. apply Stream.forever_impl_compat.
-intros ? ? id. eauto using (@Between_eventually_activated id _ id).
+intros ? ? id.
+eapply (@Between_eventually_activated id _ id);eauto.
Qed.
(** [Between g h d k] is monotonic on [k]. *)
@@ -787,7 +790,7 @@ Definition da_with_all_activated da := {|
choose_inactive_compat := da.(choose_inactive_compat) |}.
Lemma da_with_all_activated_FSYNC_da : forall da, FSYNC_da (da_with_all_activated da).
-Proof. now intros da id. Qed.
+Proof using . now intros da id. Qed.
(** An unfair demon activates at least one activable robot if such a robot exists. *)
Definition unfair_da r da config :=
diff --git a/Core/Identifiers.v b/Core/Identifiers.v
index accf887f6d45539346e12568344cf5d6186fae68..d6a61b02be35b598c7ca4a47e95addcf00234b1b 100644
--- a/Core/Identifiers.v
+++ b/Core/Identifiers.v
@@ -14,204 +14,11 @@ Require Import SetoidDec SetoidList.
Require Import Arith_base.
Require Import Lia.
Require Import Pactole.Util.Coqlib.
+Require Import Pactole.Util.Fin.
+Require Import Pactole.Util.Enum.
Set Implicit Arguments.
-Typeclasses eauto := (bfs).
-
-
-(* TODO: should we add a fold operator? *)
-(* FIXME: change the equalities to use equiv and the Setoid class *)
-
-(** Finite sets as a prefix of natural numbers. *)
-Notation "'fin' N" := {n : nat | n < N} (at level 10).
-
-Lemma subset_dec : forall N (x y : fin N), {x = y} + {x <> y}.
-Proof using .
-intros N [x Hx] [y Hy]. destruct (Nat.eq_dec x y).
-+ subst. left. f_equal. apply le_unique.
-+ right. intro Habs. inv Habs. auto.
-Qed.
-
-Lemma eq_proj1 : forall N (x y : fin N), proj1_sig x = proj1_sig y -> x = y.
-Proof using . intros N [x Hx] [y Hy] ?. simpl in *. subst. f_equal. apply le_unique. Qed.
-
-Program Fixpoint build_enum N k (Hle : k <= N) acc : list (fin N) :=
- match k with
- | 0 => acc
- | S m => @build_enum N m _ (exist (fun x => x < N) m _ :: acc)
- end.
-Next Obligation.
-lia.
-Qed.
-
-(** A list containing all elements of [fin N]. *)
-Definition enum N : list (fin N) := build_enum (Nat.le_refl N) nil.
-
-(** Specification of [enum]. *)
-Lemma In_build_enum : forall N k (Hle : k <= N) l x, In x (build_enum Hle l) <-> In x l \/ proj1_sig x < k.
-Proof using .
-intros N k. induction k; intros Hle l x; simpl.
-+ intuition.
-+ rewrite IHk. simpl. split; intro Hin.
- - destruct Hin as [[Hin | Hin] | Hin]; intuition; [].
- subst. simpl. right. lia.
- - destruct Hin as [Hin | Hin]; intuition; [].
- assert (Hcase : proj1_sig x < k \/ proj1_sig x = k) by lia.
- destruct Hcase as [Hcase | Hcase]; intuition; [].
- subst. do 2 left. destruct x; f_equal; simpl in *. apply le_unique.
-Qed.
-
-Lemma In_enum : forall N x, In x (enum N) <-> proj1_sig x < N.
-Proof using . intros. unfold enum. rewrite In_build_enum. simpl. intuition. Qed.
-
-(** Length of [enum]. *)
-Lemma build_enum_length : forall N k (Hle : k <= N) l, length (build_enum Hle l) = k + length l.
-Proof using .
-intros N k. induction k; intros Hle l; simpl.
-+ reflexivity.
-+ rewrite IHk. simpl. lia.
-Qed.
-
-Lemma enum_length : forall N, length (enum N) = N.
-Proof using . intro. unfold enum. now rewrite build_enum_length. Qed.
-
-(** [enum] does not contain duplicates. *)
-Lemma build_enum_NoDup : forall N k (Hle : k <= N) l,
- (forall x, In x l -> k <= proj1_sig x) -> NoDup l -> NoDup (build_enum Hle l).
-Proof using .
-intros N k. induction k; intros Hle l Hin Hl; simpl; auto; [].
-apply IHk.
-+ intros x [Hx | Hx].
- - now subst.
- - apply Hin in Hx. lia.
-+ constructor; trivial; [].
- intro Habs. apply Hin in Habs. simpl in Habs. lia.
-Qed.
-
-Lemma enum_NoDup : forall N, NoDup (enum N).
-Proof using . intro. unfold enum. apply build_enum_NoDup; simpl; intuition; constructor. Qed.
-
-(** [enum] is sorted in increasing order. *)
-Notation Flt := (fun x y => lt (proj1_sig x) (proj1_sig y)).
-
-Lemma build_enum_Sorted : forall N k (Hle : k <= N) l,
- (forall x, In x l -> k <= proj1_sig x) -> Sorted Flt l -> Sorted Flt (build_enum Hle l).
-Proof using .
-intros N k. induction k; intros Hle l Hin Hl; simpl; auto; [].
-apply IHk.
-+ intros x [Hx | Hx].
- - now subst.
- - apply Hin in Hx. lia.
-+ constructor; trivial; [].
- destruct l; constructor; []. simpl. apply Hin. now left.
-Qed.
-
-Lemma enum_Sorted : forall N, Sorted Flt (enum N).
-Proof using . intro. unfold enum. apply build_enum_Sorted; simpl; intuition. Qed.
-
-(** Extensional equality of functions is decidable over finite domains. *)
-Lemma build_enum_app_nil : forall N k (Hle : k <= N) l,
- build_enum Hle l = build_enum Hle nil ++ l.
-Proof using .
-intros N k. induction k; intros Hle l; simpl.
-+ reflexivity.
-+ now rewrite (IHk _ (_ :: nil)), IHk, <- app_assoc.
-Qed.
-
-Theorem build_enum_eq : forall {A} eqA N (f g : fin N -> A) k (Hle : k <= N) l,
- eqlistA eqA (List.map f (build_enum Hle l)) (List.map g (build_enum Hle l)) ->
- forall x, proj1_sig x < k -> eqA (f x) (g x).
-Proof using .
-intros A eqA N f g k. induction k; intros Hle l Heq x Hx; simpl.
-* destruct x; simpl in *; lia.
-* assert (Hlt : k <= N) by lia.
- assert (Hcase : proj1_sig x < k \/ proj1_sig x = k) by lia.
- destruct Hcase as [Hcase | Hcase].
- + apply IHk with (x := x) in Heq; auto.
- + subst k. simpl in Heq. rewrite build_enum_app_nil, map_app, map_app in Heq.
- destruct (eqlistA_app_split _ _ _ _ Heq) as [_ Heq'].
- - now do 2 rewrite map_length, build_enum_length.
- - simpl in Heq'. inv Heq'.
- assert (Heqx : x = exist (fun x => x < N) (proj1_sig x) Hle).
- { clear. destruct x; simpl. f_equal. apply le_unique. }
- now rewrite Heqx.
-Qed.
-
-Corollary enum_eq : forall {A} eqA N (f g : fin N -> A),
- eqlistA eqA (List.map f (enum N)) (List.map g (enum N)) -> forall x, eqA (f x) (g x).
-Proof using .
-unfold enum. intros A eqA N f g Heq x.
-apply build_enum_eq with (x := x) in Heq; auto; []. apply proj2_sig.
-Qed.
-
-(** Cutting [enum] after some number of elements. *)
-Lemma firstn_build_enum_le : forall N k (Hle : k <= N) l k' (Hk : k' <= N), k' <= k ->
- firstn k' (build_enum Hle l) = @build_enum N k' Hk nil.
-Proof using .
-intros N k. induction k; intros Hk l k' Hk' Hle.
-* assert (k' = 0) by lia. now subst.
-* rewrite build_enum_app_nil, firstn_app, build_enum_length.
- replace (k' - (S k + length (@nil (fin N)))) with 0 by lia.
- rewrite app_nil_r.
- destruct (Nat.eq_dec k' (S k)) as [Heq | Heq].
- + subst k'. rewrite firstn_all2.
- - f_equal. apply le_unique.
- - rewrite build_enum_length. simpl. lia.
- + simpl build_enum. erewrite IHk.
- - f_equal.
- - lia.
-Qed.
-
-Lemma firstn_build_enum_lt : forall N k (Hle : k <= N) l k', k <= k' ->
- firstn k' (build_enum Hle l) = build_enum Hle (firstn (k' - k) l).
-Proof using .
-intros N k. induction k; intros Hle l k' Hk.
-+ now rewrite Nat.sub_0_r.
-+ rewrite build_enum_app_nil, firstn_app, build_enum_length, Nat.add_0_r.
- rewrite firstn_all2, <- build_enum_app_nil; trivial; [].
- rewrite build_enum_length. simpl. lia.
-Qed.
-
-Lemma firstn_enum_le : forall N k (Hle : k <= N), firstn k (enum N) = build_enum Hle nil.
-Proof using . intros. unfold enum. now apply firstn_build_enum_le. Qed.
-
-Lemma firstn_enum_lt : forall N k, N <= k -> firstn k (enum N) = enum N.
-Proof using . intros. unfold enum. now rewrite firstn_build_enum_lt, firstn_nil. Qed.
-
-Lemma firstn_enum_spec : forall N k x, In x (firstn k (enum N)) <-> proj1_sig x < k.
-Proof using .
-intros N k x. destruct (le_lt_dec k N) as [Hle | Hlt].
-+ rewrite (firstn_enum_le Hle), In_build_enum. simpl. intuition.
-+ rewrite (firstn_enum_lt (lt_le_weak _ _ Hlt)).
- split; intro Hin.
- - transitivity N; trivial; []. apply proj2_sig.
- - apply In_enum, proj2_sig.
-Qed.
-
-(** Removing some number of elements from the head of [enum]. *)
-Lemma skipn_build_enum_lt : forall N k (Hle : k <= N) l k', k <= k' ->
- skipn k' (build_enum Hle l) = skipn (k' - k) l.
-Proof using .
-intros N k Hle l k' Hk'. apply app_inv_head with (firstn k' (build_enum Hle l)).
-rewrite firstn_skipn, firstn_build_enum_lt; trivial; [].
-rewrite (build_enum_app_nil Hle (firstn _ _)).
-now rewrite build_enum_app_nil, <- app_assoc, firstn_skipn.
-Qed.
-
-Lemma skipn_enum_lt : forall N k, N <= k -> skipn k (enum N) = nil.
-Proof using . intros. unfold enum. now rewrite skipn_build_enum_lt, skipn_nil. Qed.
-
-Lemma skipn_enum_spec : forall N k x, In x (skipn k (enum N)) <-> k <= proj1_sig x < N.
-Proof using .
-intros N k x. split; intro Hin.
-+ assert (Hin' : ~In x (firstn k (enum N))).
- { intro Habs. rewrite <- InA_Leibniz in *. revert x Habs Hin. apply NoDupA_app_iff; autoclass; [].
- rewrite firstn_skipn. rewrite NoDupA_Leibniz. apply enum_NoDup. }
- rewrite firstn_enum_spec in Hin'. split; auto with zarith; []. apply proj2_sig.
-+ assert (Hin' : In x (enum N)) by apply In_enum, proj2_sig.
- rewrite <- (firstn_skipn k), in_app_iff, firstn_enum_spec in Hin'. intuition lia.
-Qed.
(** ** Byzantine Robots *)
@@ -295,15 +102,15 @@ destruct id as [g | b], id' as [g' | b']; try (now right; discriminate); [|].
- right; intro Habs. now injection Habs.
Qed.
-Instance ident_Setoid `{Names} : Setoid ident := { equiv := eq; setoid_equiv := eq_equivalence }.
-Instance ident_EqDec `{Names} : EqDec ident_Setoid := names_eq_dec.
+Global Instance ident_Setoid `{Names} : Setoid ident := { equiv := eq; setoid_equiv := eq_equivalence }.
+Global Instance ident_EqDec `{Names} : EqDec ident_Setoid := names_eq_dec.
-Instance fun_refl `{Names} : forall A (f : ident -> A) R,
+Global Instance fun_refl `{Names} : forall A (f : ident -> A) R,
Reflexive R -> Proper (@SetoidClass.equiv ident _ ==> R) f.
Proof using . intros A f R HR ? ? Heq. simpl in Heq. now subst. Qed.
-Instance list_ident_Setoid `{Names} : Setoid (list ident) := { equiv := eq; setoid_equiv := eq_equivalence }.
-Instance list_ident_Eqdec `{Names} : EqDec list_ident_Setoid := list_eq_dec ident_EqDec.
+Global Instance list_ident_Setoid `{Names} : Setoid (list ident) := { equiv := eq; setoid_equiv := eq_equivalence }.
+Global Instance list_ident_Eqdec `{Names} : EqDec list_ident_Setoid := list_eq_dec ident_EqDec.
Lemma fun_names_eq `{Names} : forall {A : Type} eqA f g,
@eqlistA A eqA (List.map f names) (List.map g names) -> forall x, eqA (f x) (g x).
@@ -316,27 +123,69 @@ unfold names in Heq. repeat rewrite ?map_app, map_map in Heq. apply eqlistA_app_
+ now do 2 rewrite map_length.
Qed.
+Section Robots.
+
(** Given a number of correct and Byzantine robots, we can build canonical names.
It is not declared as a global instance to avoid creating spurious settings. *)
Definition Robots (n m : nat) : Names.
-Proof.
-refine {|
- nG := n;
- nB := m;
- G := fin n;
- B := fin m;
- Gnames := enum n;
- Bnames := enum m |}.
-+ abstract (intro g; apply In_enum, proj2_sig).
-+ abstract (intro b; apply In_enum, proj2_sig).
-+ apply enum_NoDup.
-+ apply enum_NoDup.
-+ apply enum_length.
-+ apply enum_length.
-+ apply subset_dec.
-+ apply subset_dec.
-+ intros ? ?. apply enum_eq.
-+ intros ? ?. apply enum_eq.
+Proof using .
+ refine {|
+ nG := n;
+ nB := m;
+ G := fin n;
+ B := fin m;
+ Gnames := enum n;
+ Bnames := enum m |}.
+ + abstract (intro g; apply In_enum, fin_lt).
+ + abstract (intro b; apply In_enum, fin_lt).
+ + apply enum_NoDup.
+ + apply enum_NoDup.
+ + apply enum_length.
+ + apply enum_length.
+ + apply fin_dec.
+ + apply fin_dec.
+ + intros ? ?. apply enum_eq.
+ + intros ? ?. apply enum_eq.
Defined.
Global Opaque G B.
+(* TODO: discuss this
+Section NM.
+
+Variables n m: nat.
+
+Notation GRob := (@G (Robots n m)).
+Notation BRob := (@B (Robots n m)).
+
+Lemma GRob_Robots : GRob = fin n.
+Proof using . reflexivity. Qed.
+
+Lemma BRob_Robots : BRob = fin m.
+Proof using . reflexivity. Qed.
+
+Lemma GRob_Robots_eq_iff : forall g1 g2 : GRob, g1 = g2 :> GRob <-> g1 = g2 :> fin n.
+Proof using . reflexivity. Qed.
+
+Lemma BRob_Robots_eq_iff : forall b1 b2 : BRob, b1 = b2 :> BRob <-> b1 = b2 :> fin m.
+Proof using . reflexivity. Qed.
+
+Definition good0 : GRob := fin0.
+
+Definition byz0 : BRob := fin0.
+
+Lemma all_good0 : forall g : GRob, n = 1 -> g = good0.
+Proof using . intros * H. rewrite GRob_Robots_eq_iff. apply all_fin0, H. Qed.
+
+Lemma all_good_eq : forall g1 g2 : GRob, n = 1 -> g1 = g2.
+Proof using ltc_l_n. intros * H. rewrite GRob_Robots_eq_iff. apply all_eq, H. Qed.
+
+Lemma all_byz0 : forall b : BRob, m = 1 -> b = byz0.
+Proof using . intros * H. rewrite BRob_Robots_eq_iff. apply all_fin0, H. Qed.
+
+Lemma all_byz_eq : forall b1 b2 : BRob, m = 1 -> b1 = b2.
+Proof using ltc_l_m. intros * H. rewrite BRob_Robots_eq_iff. apply all_eq, H. Qed.
+End NM.
+
+*)
+
+End Robots.
diff --git a/Core/State.v b/Core/State.v
index 8e34afbbb127738799d1d83d476736a08b848e6f..b8cec83788aeec79b85c22804772baaa5f6390db 100644
--- a/Core/State.v
+++ b/Core/State.v
@@ -34,8 +34,8 @@ Require Import Pactole.Core.Identifiers.
Instead, the user must explicitely provide the instance. *)
Class Location := {
location : Type;
- location_Setoid :> Setoid location;
- location_EqDec :> EqDec location_Setoid }.
+ #[global] location_Setoid :: Setoid location;
+ #[global] location_EqDec :: EqDec location_Setoid }.
Definition make_Location (T : Type) `{EqDec T} := {| location := T |}.
Arguments make_Location T {_} {_}.
@@ -54,15 +54,15 @@ Arguments make_Location T {_} {_}.
Class State `{Location} info := {
get_location : info -> location;
(** States are equipped with a decidable equality *)
- state_Setoid :> Setoid info;
- state_EqDec :> EqDec state_Setoid;
+ #[global] state_Setoid :: Setoid info;
+ #[global] state_EqDec :: EqDec state_Setoid;
(** Lifting a change of frame from a location to a full state, under some precondition *)
precondition : (location -> location) -> Type;
lift : sigT precondition -> info -> info;
get_location_lift : forall f state, get_location (lift f state) == projT1 f (get_location state);
(** Compatibility properties *)
- get_location_compat :> Proper (equiv ==> equiv) get_location;
- lift_compat :>
+ #[global] get_location_compat :: Proper (equiv ==> equiv) get_location;
+ #[global] lift_compat ::
Proper ((equiv ==> equiv)%signature @@ (@projT1 _ precondition) ==> equiv ==> equiv) lift }.
(* We cannot have [lift_compat :> Proper (equiv ==> equiv ==> equiv) lift]
because we also need extensionality in the input function, which function's [equiv] has not. *)
@@ -89,9 +89,9 @@ refine {|
precondition := precondition |}.
Proof.
+ apply prod_EqDec; apply state_EqDec || apply location_EqDec.
-+ intros f []. simpl. apply get_location_lift.
-+ intros [] [] []. simpl. now apply get_location_compat.
-+ intros f g Hfg []. simpl. split.
++ intros f []. cbn. apply get_location_lift.
++ intros [] [] []. cbn. now apply get_location_compat.
++ intros f g Hfg []. cbn. split.
- now apply lift_compat.
- now apply Hfg.
Defined.
@@ -103,9 +103,9 @@ refine {| get_location := fun x => get_location (fst x);
precondition := precondition |}.
Proof.
+ apply prod_EqDec; apply state_EqDec || auto.
-+ intros f []. simpl. apply get_location_lift.
-+ intros [] [] []. simpl. now apply get_location_compat.
-+ intros f g Hfg [] [] []. simpl in *. split; trivial; []. now apply lift_compat.
++ intros f []. cbn. apply get_location_lift.
++ intros [] [] []. cbn. now apply get_location_compat.
++ intros f g Hfg [] [] []. cbn in *. split; trivial; []. now apply lift_compat.
Defined.
(* RMK: As [AddLocation] has less parameters than [AddInfo], its priority is higher,
@@ -122,9 +122,9 @@ Proof.
+ apply sig_Setoid, state_Setoid.
+ autoclass.
+ apply (snd (projT2 f)), proj2_sig.
-+ intros f x. simpl. apply get_location_lift.
++ intros f x. cbn. apply get_location_lift.
+ repeat intro. now apply get_location_compat.
-+ intros f g Hfg x y Hxy. simpl. now apply lift_compat.
++ intros f g Hfg x y Hxy. cbn. now apply lift_compat.
Defined.
(** A more general version restricting a state to have a dependent witness of some type. *)
@@ -138,8 +138,8 @@ Proof.
+ apply sigT_Setoid, state_Setoid.
+ autoclass.
+ apply (snd (projT2 f)), projT2.
-+ intros f x. simpl. apply get_location_lift.
++ intros f x. cbn. apply get_location_lift.
+ repeat intro. now apply get_location_compat.
-+ intros f g Hfg x y Hxy. simpl. now apply lift_compat.
++ intros f g Hfg x y Hxy. cbn. now apply lift_compat.
Defined.
(* end show *)
diff --git a/INSTALL.md b/INSTALL.md
new file mode 100644
index 0000000000000000000000000000000000000000..1d7367e4b0694976bd6ebbc2c51f603f6dacffaf
--- /dev/null
+++ b/INSTALL.md
@@ -0,0 +1,117 @@
+
+# Requirements
+
+- Coq 8.19 or 8.20 (including the executable `coqc`, `codep`, `coq_makefile`)
+- GNU `make`
+
+# Configuration
+
+You should perform once the following command to generate the Makefile:
+
+```bash
+coq_makefile -f _CoqProject -o Makefile
+```
+
+# Compilation
+
+To compile the whole projet including case studies:
+
+``` bash
+make
+```
+
+# Use in your coq development
+
+Suppose you have compiled Pactole in a directory calle `pactole` and
+you want to use it in your own development called `myproject`. You
+should use a `_CoqProject` file containing:
+
+```
+-Q pactole Pactole
+.. # your own project options
+```
+
+and use `coq_makefile -f _CoqProject -o Makefile` to generate your
+makefile. Note that ProofGeneral and other IDE also read the
+`_CoqProject`.
+
+From now on you can use Pactole in your coq files by importing the
+relevant modules, e.g.:
+
+``` coq
+Require Import Pactole.Core.Formalism.
+```
+
+See the file README.md for the directory structure of the library.
+
+# NOTES FOR DEVELOPPERS
+
+Pactole provides fast (and unsafe) compilation target. This is
+explained in this section.
+
+
+## build (slow)
+
+The default makefile target may take more than 10mn to compile due to
+some case studies. You may want to comment them in the _CoqProject
+file before the configure step above if you are not interested in
+these case studies. Another solution is to follow the fast compilation
+recipes below.
+
+Doing this once a week when developing is good practice. This is the
+only way to make a really safe compilation including all
+xxx_Assumption.v. You should always do this once in a while to make
+sure some universe constraints aren't failing and to check if you did
+not miss any remaining axiom.
+
+But during the development process this makes the compilation when
+switching between files too slow. Hence the following less safe
+compilation processes:
+
+## unsafe builds when developing
+
+During development you can benefit from coq's "vos/vok" generation to
+speed up compilation. The only specificity of Pactole concerns
+compilation of the files named xxx_Assumptions.v. This files print the
+sets of assumptions used in the proofs of final lemmas in Case
+studies. Compiling these files for vos/vok target would raise errors.
+We provide adapted targets below.
+
+## build (slow, almost safe, but very parallelisable)
+
+```
+make [-j] vok
+```
+or better when developing
+```
+make [-j] vok-nocheck
+```
+Doing this once a day when developing is good practice.
+
+## build (Very fast, unsafe)
+
+```
+make [-j] vos
+```
+or better when developing
+```
+make [-j] vos-nocheck
+```
+
+This should be your prefered way of compiling when developing. It is
+much faster. It is unsafe but in most situations no bad surprise is to
+be expected.
+
+You should do real compilations from time to time as explained above.
+
+## Proofgeneral
+
+For easy use of this feature (vos) you can use the auto compilation
+feature of proofgeneral. menu:
+
+menu: Coq / Auto Compilation / Compile Before Require
+and then: Coq / Auto Compilation / vos compilation
+
+Now you can transparently script in any buffer, all needed file will
+be compiled quickly. Don't forget to make a big fat "make" from time
+to time.
diff --git a/Makefile.local b/Makefile.local
index 0dc2b56c229a095ed6bdcacd2aa52a372d0de584..060b3d563d3f0159cf4d3dbcd34f7f7223355165 100644
--- a/Makefile.local
+++ b/Makefile.local
@@ -33,8 +33,24 @@ vok-nocheck: $(VOKFILESNOASSUMPTION)
# developpers could use this.
# COQEXTRAFLAGS+= -set "Suggest Proof Using=yes" -w -deprecated-instance-without-locality
+COQEXTRAFLAGS+= -set "Suggest Proof Using=yes"
+#COQEXTRAFLAGS+= -w -deprecated-instance-without-locality
+#COQEXTRAFLAGS+= -w -intuition-auto-with-star
+#COQEXTRAFLAGS+= -w -argument-scope-delimiter
+COQEXTRAFLAGS+= -w -deprecated-syntactic-definition
+#COQEXTRAFLAGS+= -w -future-coercion-class-field
+
+
core: Pactole_all.vo
+# make ../foo.check Ask to compile foo.v id necessary and then coqchk foo.vo
+%.check: %.vo
+ $(TIMER) $(COQCHK) $(COQCHKFLAGS) $(COQLIBS_NOML) $<
+
+# make ../foo.v displays the dependencies of foo.v
+%.dep: %.v
+ $(TIMER) $(COQDEP) $(COQLIBS) $<
+
recore:
dev/rebuild_pactole_all.sh > Pactole_all.v
make Pactole_all.vo
diff --git a/Models/ContinuousGraph.v b/Models/ContinuousGraph.v
index e7b3f8b71044a59b5cb13a3a6b5fe683ef33eff5..dd141bbc2c21b315755ab3a47a13a9217e9eb63e 100644
--- a/Models/ContinuousGraph.v
+++ b/Models/ContinuousGraph.v
@@ -17,15 +17,10 @@
*)
(**************************************************************************)
-Require Import Utf8_core.
-Require Import Arith_base.
-Require Import Reals.
-Require Import Lia.
-Require Import Psatz.
-Require Import SetoidList.
-Require Import Pactole.Setting.
-Require Import Pactole.Spaces.Graph.
-Require Import Pactole.Spaces.Isomorphism.
+Require Import Utf8_core Arith_base Reals Lia Psatz SetoidList.
+From Pactole Require Import Setting Util.SetoidDefs Util.Bijection.
+From Pactole Require Import Spaces.Graph Spaces.Isomorphism
+ Spaces.ThresholdIsomorphism.
Require Import Pactole.Models.Flexible.
@@ -36,8 +31,8 @@ Remove Hints eq_setoid : typeclass_instances.
Section CGF.
Context {V E : Type}.
-Context `{Names}.
-Context {G : Graph V E}.
+Context {N : Names}.
+Context {TG : ThresholdGraph V E}.
Instance LocationV : Location := { location := V }.
@@ -53,6 +48,9 @@ Global Instance E_src_tgt_thd_EqDec : EqDec E_src_tgt_thd_Setoid :=
Global Instance E_subrelation : subrelation (@equiv E E_Setoid) (@equiv E E_src_tgt_thd_Setoid).
Proof using . intros ? ? Heq. split; simpl; now rewrite Heq. Qed.
+Global Instance E_subrelation' : subrelation (@equiv E E_src_tgt_thd_Setoid) (@equiv E E_Setoid).
+Proof using . intros ?? [H _]. apply simple_graph, H. Qed.
+
Global Instance src_compat : Proper (equiv ==> equiv) src.
Proof using . intros ? ? Heq. apply Heq. Qed.
@@ -64,14 +62,14 @@ Proof using . intros ? ? Heq. apply Heq. Qed.
(* Since iso_E gives a bijection that comes with its setoid,
we need to be lower level to change it from [E_Setoid] to [E_src_tgt_thd_Setoid]. *)
-Global Instance iso_E_compat : forall iso,
- Proper (equiv ==> equiv) (iso_E iso).
+Global Instance iso_E_compat :
+ ∀ iso : threshold_isomorphism TG, Proper (equiv ==> equiv) (iso_E iso).
Proof using .
-intros iso ? ? [[Hsrc Htgt] Hthd].
-repeat split; unfold equiv in *; cbn -[equiv] in *.
-- now rewrite <- 2 (proj1 (iso_morphism _ _)), Hsrc.
-- now rewrite <- 2 (proj2 (iso_morphism _ _)), Htgt.
-- rewrite <- 2 iso_threshold. now f_equiv.
+ intros iso ? ? [[Hsrc Htgt] Hthd].
+ repeat split; unfold equiv in *; cbn -[equiv] in *.
+ - now rewrite <- 2 (proj1 (iso_morphism _ _)), Hsrc.
+ - now rewrite <- 2 (proj2 (iso_morphism _ _)), Htgt.
+ - rewrite <- iso_threshold, Hthd. apply iso_threshold.
Qed.
@@ -87,11 +85,11 @@ simple refine {| equiv := fun l l' =>
| OnEdge e p, OnEdge e' p' => e == e' /\ p == p'
| _, _ => False
end |}; autoclass; [].
-Proof. split.
-+ now intros [].
-+ intros [] [] Heq; simpl in *; decompose [False and] Heq; repeat split; now symmetry.
-+ intros [] [] [] Heq1 Heq2; simpl in *;
- decompose [False and] Heq1; decompose [False and] Heq2; repeat split; etransitivity; eauto.
+Proof using . split.
+ + now intros [].
+ + intros [] [] Heq; simpl in *; decompose [False and] Heq; repeat split; now symmetry.
+ + intros [] [] [] Heq1 Heq2; simpl in *;
+ decompose [False and] Heq1; decompose [False and] Heq2; repeat split; etransitivity; eauto.
Defined.
Global Instance locG_EqDec: EqDec locG_Setoid.
@@ -115,53 +113,32 @@ Global Instance OnEdge_compat : Proper (equiv ==> equiv ==> equiv) OnEdge.
Proof using . repeat intro. auto. Qed.
(** We can use an isomorphism to build a bijection on a continuous graph. *)
-Definition bijectionG (iso : isomorphism G) : Bijection.bijection loc.
-simple refine {| Bijection.section := fun pt => match pt with
+Definition bijectionG (iso : threshold_isomorphism TG) : bijection loc.
+simple refine {| section := fun pt => match pt with
| OnVertex v => OnVertex (iso.(iso_V) v)
| OnEdge e p => OnEdge (iso.(iso_E) e) p
end;
- Bijection.retraction := fun pt => match pt with
- | OnVertex v => OnVertex (Bijection.retraction iso.(iso_V) v)
- | OnEdge e p => OnEdge (Bijection.retraction iso.(iso_E) e) p
+ retraction := fun pt => match pt with
+ | OnVertex v => OnVertex (retraction iso.(iso_V) v)
+ | OnEdge e p => OnEdge (retraction iso.(iso_E) e) p
end |}.
-Proof.
-* intros [| e1 p1] [| e2 p2] Heq; simpl in Heq; trivial.
- + now repeat f_equiv.
- + destruct Heq as [[[Hsrc Htgt] Hthd] Hp]. repeat split; simpl.
- - rewrite <- (proj1 (iso_morphism iso e1)), Hsrc. apply iso_morphism.
- - rewrite <- (proj2 (iso_morphism iso e1)), Htgt. apply iso_morphism.
- - now rewrite <- 2 iso_threshold, Hthd.
- - assumption.
-* intros [| e1 p1] [| e2 p2] ; simpl in *; try tauto; [|]; split; intro Heq.
- + rewrite <- Heq. apply Bijection.retraction_section.
- + rewrite <- Heq. apply Bijection.section_retraction.
- + destruct Heq as [[[Hsrc Htgt] Hthd] Hp]. repeat split.
- - change (Bijection.retraction (iso_E iso)) with (Bijection.section (iso_E (inverse iso))).
- rewrite <- (proj1 (iso_morphism _ e2)). simpl.
- now rewrite <- (Bijection.Inversion iso), (proj1 (iso_morphism _ e1)).
- - change (Bijection.retraction (iso_E iso)) with (Bijection.section (iso_E (inverse iso))).
- rewrite <- (proj2 (iso_morphism _ e2)). simpl.
- now rewrite <- (Bijection.Inversion iso), (proj2 (iso_morphism _ e1)).
- - change (Bijection.retraction (iso_E iso)) with (Bijection.section (iso_E (inverse iso))).
- rewrite <- (iso_threshold _ e2), <- Hthd, iso_threshold.
- simpl. now rewrite Bijection.retraction_section.
- - auto.
- + destruct Heq as [[[Hsrc Htgt] Hthd] Hp]. repeat split.
- - now rewrite <- (proj1 (iso_morphism _ e1)), <- Hsrc, (proj1 (iso_morphism _ _)),
- Bijection.section_retraction.
- - now rewrite <- (proj2 (iso_morphism _ e1)), <- Htgt, (proj2 (iso_morphism _ _)),
- Bijection.section_retraction.
- - now rewrite <- (iso_threshold _ e1), <- Hthd, (iso_threshold _ _),
- Bijection.section_retraction.
- - auto.
+Proof using .
+ * intros [l1 | e1 p1] [l2 | e2 p2] H. 2,3: inversion H.
+ + cbn in H. rewrite H. reflexivity.
+ + destruct H as [H1 H2]. rewrite H1, H2. reflexivity.
+ * intros [l1 | e1 p1] [l2 | e2 p2]. all: split. all: intros H. 3-6: inversion H.
+ + cbn in H. rewrite <- H, retraction_section. reflexivity.
+ + cbn in H. rewrite <- H, section_retraction. reflexivity.
+ + destruct H as [H1 H2]. erewrite (proj1 (Inversion _ _ _)).
+ rewrite H2. reflexivity. apply E_subrelation', H1.
+ + destruct H as [H1 H2]. erewrite (proj2 (Inversion _ _ _)).
+ rewrite H2. reflexivity. apply E_subrelation', H1.
Defined.
Global Instance bijectionG_compat : Proper (equiv ==> equiv) bijectionG.
Proof using .
-intros iso1 iso2 Hiso []; simpl.
-+ apply Hiso.
-+ repeat split; apply Graph.src_compat || apply Graph.tgt_compat
- || apply Graph.threshold_compat; apply Hiso.
+ intros iso1 iso2 Hiso [l | e p]. apply Hiso. split.
+ apply E_subrelation, Hiso. reflexivity.
Qed.
(** ** Translation of locations *)
@@ -169,23 +146,16 @@ Qed.
Definition location_G2V (loc : locG) : locV :=
match loc with
| OnVertex l => l
- | OnEdge e p => if Rle_dec (threshold e) p then Graph.tgt e else Graph.src e
+ | OnEdge e p => if Rle_dec (threshold e) p then tgt e else src e
end.
Global Instance location_G2V_compat : Proper (equiv ==> equiv) location_G2V.
Proof using .
unfold location_G2V. intros [l1 | e1 p1] [l2 | e2 p2] Hxy; try tauto; [].
-destruct Hxy as [Hexy Hpxy],
- (Rle_dec (threshold e1) p1) eqn:Hx,
- (Rle_dec (threshold e2) p2) eqn:Hy.
-+ apply Hexy.
-+ assert (Ht := proj2 Hexy).
- assert (Hr : (threshold e1 <= p1)%R) by assumption.
- now rewrite Ht, Hpxy in Hr.
-+ assert (Hr : (threshold e2 <= p2)%R) by assumption.
- assert (Ht := proj2 Hexy).
- now rewrite <- Ht, <- Hpxy in Hr.
-+ apply Hexy.
+destruct Hxy as [[[Hsrc Htgt] Ht] Hpxy]. cbn in Ht.
+destruct (Rle_dec (threshold e1) p1) as [Hx | Hx], (threshold e1), p1,
+ (Rle_dec (threshold e2) p2) as [Hy | Hy], (threshold e2), p2;
+cbn in *; subst; tauto.
Qed.
Definition location_V2G : locV -> locG := OnVertex.
@@ -227,8 +197,8 @@ Lemma valid_stateV_iso' : forall v e iso pt, pt == iso.(iso_V) v ->
valid_stateV (v, e) -> valid_stateV (pt, iso.(iso_E) e).
Proof using .
intros v e iso pt Hpt [Hcase | Hcase].
-+ left. simpl in *. rewrite Hpt, Hcase. apply iso_morphism.
-+ right. simpl in *. rewrite Hpt, Hcase. apply iso_morphism.
++ left. cbn in *. rewrite Hpt, Hcase. apply iso_morphism.
++ right. cbn in *. rewrite Hpt, Hcase. apply iso_morphism.
Qed.
(** In the continuous case, the state must also contain the destination of the robot.
@@ -286,7 +256,7 @@ Proof using . intros ? ? []. unfold state_V2G. now split. Qed.
Definition state_G2V (state : stateG) : stateV :=
match state with
| SOnVertex v e p => exist valid_stateV (v, e) p
- | SOnEdge e p => if Rle_dec (@threshold locV E G e) p
+ | SOnEdge e p => if Rle_dec (@threshold locV E TG e) p
then exist valid_stateV (Graph.tgt e, e) ltac:(now right)
else exist valid_stateV (Graph.src e, e) ltac:(now left)
end.
@@ -296,11 +266,11 @@ Proof using .
intros [v e p | e p] [v' e' p' | e' p'] Hstate; auto; [].
destruct Hstate as [[[Hsrc Htgt] Hthd] Hp]. simpl.
destruct (Rle_dec (threshold e) p), (Rle_dec (threshold e') p');
-repeat split; simpl in *; rewrite ?Hsrc, ?Htgt, ?Hthd in *; try reflexivity; [|];
-destruct p, p'; simpl in *; subst; contradiction.
+repeat split; cbn in *; rewrite ?Hsrc, ?Htgt, ?Hthd in *; try reflexivity; [|];
+destruct (threshold e), p, (threshold e'), p'; cbn in *; subst; tauto.
Qed.
-Lemma state_V2G2V : forall state, state_G2V (state_V2G state) == state.
+Lemma state_V2G2V : ∀ state, state_G2V (state_V2G state) == state.
Proof using . intro. simpl. repeat (split; try reflexivity). Qed.
(** ** On configurations *)
@@ -308,31 +278,32 @@ Proof using . intro. simpl. repeat (split; try reflexivity). Qed.
(** The precondition for liftable changes of frame is that they must come from isomorphisms
(which must not change the thresholds). *)
Local Instance InfoV : @State LocationV stateV.
-simple refine {|
+Proof using .
+ simple refine {|
get_location := fun state => fst (proj1_sig state);
- state_Setoid := stateV_Setoid;
- precondition := fun f => sigT (fun iso => f == iso.(iso_V) /\ iso_T iso == @Bijection.id R _);
- lift := fun f state => exist _ (projT1 f (fst (proj1_sig state)),
- iso_E (projT1 (projT2 f)) (snd (proj1_sig state))) _ |}; autoclass.
-Proof.
-+ abstract (destruct f as [f [iso [Hiso ?]]], state as [state [Hcase | Hcase]];
- cbn; left + right; rewrite Hiso, Hcase; cbn; apply iso_morphism).
-+ intros ? ? Heq. apply Heq.
-+ (* lift_compat *)
- intros [f [iso1 [Hiso1 Ht1]]] [g [iso2 [Hiso2 Ht2]]] Heq [] [] [Heq1 [Heq2 Heq3]].
- cbn in *. repeat split.
- - now apply Heq.
- - rewrite <- (proj1 (iso_morphism iso1 _)), <- Hiso1,
- <- (proj1 (iso_morphism iso2 _)), <- Hiso2.
- now apply Heq.
- - rewrite <- (proj2 (iso_morphism iso1 _)), <- Hiso1,
- <- (proj2 (iso_morphism iso2 _)), <- Hiso2.
- now apply Heq.
- - now rewrite <- 2 iso_threshold, Ht1, Ht2.
+ state_Setoid := stateV_Setoid;
+ precondition := λ f, sigT (λ iso : threshold_isomorphism TG,
+ f == iso.(iso_V) /\ iso_T iso == Bijection.id);
+ lift := λ f state, exist _ (projT1 f (fst (proj1_sig state)),
+ iso_E (projT1 (projT2 f)) (snd (proj1_sig state))) _ |}; autoclass.
+ + abstract (destruct f as [f [iso [Hiso ?]]], state as [state [Hcase | Hcase]];
+ cbn; rewrite Hiso, Hcase; left + right; apply iso_morphism).
+ + intros ? ? Heq. apply Heq.
+ + (* lift_compat *)
+ intros [f [iso1 [Hiso1 Ht1]]] [g [iso2 [Hiso2 Ht2]]] Heq [] [] [Heq1 [Heq2 Heq3]].
+ cbn in *. repeat split.
+ - now apply Heq.
+ - rewrite <- (proj1 (iso_morphism iso1 _)), <- Hiso1,
+ <- (proj1 (iso_morphism iso2 _)), <- Hiso2.
+ now apply Heq.
+ - rewrite <- (proj2 (iso_morphism iso1 _)), <- Hiso1,
+ <- (proj2 (iso_morphism iso2 _)), <- Hiso2.
+ now apply Heq.
+ - now rewrite <- 2 iso_threshold, Ht1, Ht2.
Defined.
Definition good_iso_of f iso := f == Bijection.section (bijectionG iso)
- /\ iso_T iso == @Bijection.id R _.
+ /\ iso_T iso == Bijection.id.
Definition preconditionG := fun f => sigT (good_iso_of f).
Definition liftG (f : sigT preconditionG) state :=
@@ -471,25 +442,24 @@ Proof using . intro. simpl. repeat split; reflexivity. Qed.
(** ** Demonic schedulers **)
(** Acceptable frame changes must not change the thresholds. *)
-Definition stable_threshold iso := iso_T iso == @Bijection.id R _.
+Definition stable_threshold iso := iso_T iso == Bijection.id.
-Definition stable_threshold_inverse : forall iso,
+Definition stable_threshold_inverse : ∀ iso,
stable_threshold iso -> stable_threshold (inverse iso).
Proof using .
-intros iso Hstable x. unfold stable_threshold in *. simpl in *.
-now rewrite <- (Hstable x), Bijection.retraction_section.
+ unfold stable_threshold. intros iso Hstable x. apply (injective (iso_T iso)).
+ rewrite Hstable at 2. apply section_retraction.
Qed.
(** Frame choice: graph isomorphisms not changing thresholds *)
Global Instance FrameChoiceIsomorphismV : @frame_choice LocationV (sig stable_threshold) := {|
- frame_choice_bijection := fun f => @iso_V locV E G (proj1_sig f);
- frame_choice_Setoid := sig_Setoid (@isomorphism_Setoid locV E G);
- frame_choice_bijection_compat :=
- fun f g => @iso_V_compat locV E G (proj1_sig f) (proj1_sig g) |}.
+ frame_choice_bijection := λ f : sig stable_threshold, @iso_V locV E TG (proj1_sig f);
+ frame_choice_Setoid := sig_Setoid (@threshold_isomorphism_Setoid locV E TG);
+ frame_choice_bijection_compat := ltac:(intros ?? H; apply H) |}.
Global Instance FrameChoiceIsomorphismG : @frame_choice LocationG (sig stable_threshold) := {|
frame_choice_bijection := fun f => bijectionG (proj1_sig f);
- frame_choice_Setoid := sig_Setoid (@isomorphism_Setoid locV E G);
+ frame_choice_Setoid := sig_Setoid (@threshold_isomorphism_Setoid locV E TG);
frame_choice_bijection_compat := fun f g => bijectionG_compat (proj1_sig f) (proj1_sig g) |}.
(** The demon update choice only contains the movement ratio, either a boolean or a ratio. *)
diff --git a/Models/Flexible.v b/Models/Flexible.v
index 05794447abdc89ae3d1339b349142957b1e1ad1b..b5f48b35f9a6f4789ea7db9ea728cef29c3b0430 100644
--- a/Models/Flexible.v
+++ b/Models/Flexible.v
@@ -48,7 +48,7 @@ Instance Frame : frame_choice (similarity location) := FrameChoiceSimilarity.
Class FlexibleChoice `{update_choice Tactive} := {
move_ratio : Tactive -> ratio;
- move_ratio_compat :> Proper (@equiv Tactive update_choice_Setoid ==> @equiv _ (sig_Setoid _)) move_ratio }.
+ #[global] move_ratio_compat :: Proper (@equiv Tactive update_choice_Setoid ==> @equiv _ (sig_Setoid _)) move_ratio }.
(** Flexible moves are parametrized by a minimum distance [delta] that robots must move when they are activated. *)
Class FlexibleSetting `{FlexibleChoice}
@@ -101,11 +101,15 @@ Proof.
intros config1 config2 Hconfig gg g ? sim1 sim2 Hsim traj1 traj2 Htraj Ï1 Ï2 HÏ. subst gg.
assert (Heq : get_location (traj1 Ï1) == get_location (traj2 Ï2)).
{ apply get_location_compat. now f_equiv. }
-destruct_match_eq Hle; destruct_match_eq Hle'; rewrite Heq, ?Hsim in *;
-solve [ reflexivity
- | now f_equiv
- | rewrite Hconfig, Htraj, HÏ in *; now rewrite Hle in Hle' ].
-Unshelve. all:autoclass.
+destruct_match_eq Hle; destruct_match_eq Hle'.
++ now f_equiv.
++ exfalso. apply Bool.diff_false_true. rewrite <- Hle, <- Hle'. f_equal.
+ - f_equal. now f_equiv.
+ - apply dist_compat; apply get_location_compat; auto.
++ exfalso. apply Bool.diff_false_true. rewrite <- Hle, <- Hle'. f_equal.
+ - f_equal. now f_equiv.
+ - apply dist_compat; apply get_location_compat; auto.
++ apply Htraj.
Defined.
Global Instance FlexibleChoiceFlexibleUpdate delta : FlexibleSetting (Update := FlexibleUpdate delta) delta.
diff --git a/Models/GraphEquivalence.v b/Models/GraphEquivalence.v
index 6ddf64f48a67e4dbfe742e49d6118feb5b7478ee..fde958ed810ad9358e679d6a47459994679f826f 100644
--- a/Models/GraphEquivalence.v
+++ b/Models/GraphEquivalence.v
@@ -17,14 +17,62 @@ Require Import Reals.
Require Import Psatz.
Require Import SetoidList.
+Require Import Pactole.Util.Bijection.
Require Import Pactole.Setting.
Require Import Pactole.Spaces.Graph.
Require Import Pactole.Spaces.Isomorphism.
+Require Import Pactole.Spaces.ThresholdIsomorphism.
Require Import Pactole.Models.ContinuousGraph.
Require Import Pactole.Models.DiscreteGraph.
-
-Typeclasses eauto := (bfs).
+#[local]
+Hint Extern 9 (_ = _ :>nat) => lia: zarith.
+#[local]
+Hint Extern 9 (_ <= _) => lia: zarith.
+#[local]
+Hint Extern 9 (_ < _) => lia: zarith.
+#[local]
+Hint Extern 9 (_ >= _) => lia: zarith.
+#[local]
+Hint Extern 9 (_ > _) => lia: zarith.
+
+#[local]
+Hint Extern 9 (_ <> _ :>nat) => lia: zarith.
+#[local]
+Hint Extern 9 (~ _ <= _) => lia: zarith.
+#[local]
+Hint Extern 9 (~ _ < _) => lia: zarith.
+#[local]
+Hint Extern 9 (~ _ >= _) => lia: zarith.
+#[local]
+Hint Extern 9 (~ _ > _) => lia: zarith.
+
+#[local]
+Hint Extern 9 (_ = _ :>Z) => lia: zarith.
+#[local]
+Hint Extern 9 (_ <= _)%Z => lia: zarith.
+#[local]
+Hint Extern 9 (_ < _)%Z => lia: zarith.
+#[local]
+Hint Extern 9 (_ >= _)%Z => lia: zarith.
+#[local]
+Hint Extern 9 (_ > _)%Z => lia: zarith.
+
+#[local]
+Hint Extern 9 (_ <> _ :>Z) => lia: zarith.
+#[local]
+Hint Extern 9 (~ (_ <= _)%Z) => lia: zarith.
+#[local]
+Hint Extern 9 (~ (_ < _)%Z) => lia: zarith.
+#[local]
+Hint Extern 9 (~ (_ >= _)%Z) => lia: zarith.
+#[local]
+Hint Extern 9 (~ (_ > _)%Z) => lia: zarith.
+
+#[local]
+Hint Extern 9 False => lia: zarith.
+
+(* Typeclasses eauto := (bfs). *)
Open Scope R_scope.
@@ -32,7 +80,7 @@ Section GraphEquivalence.
Context (V E : Type).
Context {NN : Names}.
-Context {G : Graph V E}.
+Context {TG : ThresholdGraph V E}.
(** We assume that the graph contains loops from each node to itself. *)
Variable self_loop : V -> E.
@@ -43,17 +91,17 @@ Ltac Rdec := repeat
match goal with
| |- context[Rdec ?x ?x] =>
let Heq := fresh "Heq" in destruct (Rdec x x) as [Heq | Heq];
- [clear Heq | exfalso; elim Heq; reflexivity]
+ [clear Heq | exfalso; contradiction Heq; reflexivity]
| |- context[Rdec 1 0] =>
let Heq := fresh "Heq" in destruct (Rdec 1 0) as [Heq | Heq];
- [now elim R1_neq_R0 | clear Heq]
+ [now contradiction R1_neq_R0 | clear Heq]
| |- context[Rdec 0 1] =>
let Heq := fresh "Heq" in destruct (Rdec 0 1) as [Heq | Heq];
- [now symmetry in Heq; elim R1_neq_R0 | clear Heq]
+ [now symmetry in Heq; contradiction R1_neq_R0 | clear Heq]
| H : context[Rdec ?x ?x] |- _ =>
let Heq := fresh "Heq" in destruct (Rdec x x) as [Heq | Heq];
- [clear Heq | exfalso; elim Heq; reflexivity]
- | H : ?x <> ?x |- _ => elim H; reflexivity
+ [clear Heq | exfalso; contradiction Heq; reflexivity]
+ | H : ?x <> ?x |- _ => contradiction H; reflexivity
end.
Existing Instance InfoV.
@@ -115,16 +163,28 @@ Proof.
exists (inverse (proj1_sig (change_frame da (config_G2V config) g))).
split; try reflexivity; []. cbn -[equiv]. apply stable_threshold_inverse, proj2_sig.
+ intros config1 config2 Hconfig gg g ?. subst gg. now rewrite Hconfig.
-+ intros config1 config2 Hconfig gg g ? traj1 traj2 Htraj. subst gg. now rewrite Hconfig, Htraj.
++ intros config1 config2 Hconfig gg g ? traj1 traj2 Htraj. subst gg.
+ destruct_match_eq Heq1; destruct_match_eq Heq2; try reflexivity; [|];
+ exfalso; apply Bool.diff_false_true; rewrite <- Heq1, <- Heq2; [ symmetry |];
+ apply (choose_update_compat da (config_G2V_compat _ _ Hconfig) (eq_refl g) _ _ Htraj).
+ intros config1 config2 Hconfig id1 id2 Hid. simpl in Hid. subst id1.
- now rewrite Hconfig.
+ destruct_match_eq Heq1; destruct_match_eq Heq2; try reflexivity; [|];
+ exfalso; apply Bool.diff_false_true; rewrite <- Heq1, <- Heq2; [ symmetry |];
+ apply (choose_inactive_compat da (config_G2V_compat _ _ Hconfig) (eq_refl id2)).
Defined.
Instance da_D2C_compat : Proper (equiv ==> equiv) da_D2C.
Proof using .
intros da1 da2 Hda. split; [| split; [| split; [| split]]]; cbn -[equiv].
+ intro. now apply activate_da_compat.
-+ intros. apply relocate_byz_D2C_compat; reflexivity || now apply relocate_byz_da_compat.
++ intros.
+ apply relocate_byz_D2C_compat.
+ * red;intros.
+ red;intros.
+ rewrite Hda,H,H0.
+ reflexivity.
+ * reflexivity.
+ * reflexivity.
+ intros config g. apply (change_frame_da_compat Hda); auto.
+ intros id rc traj. erewrite (choose_update_da_compat Hda); auto.
+ intros config id. erewrite (choose_inactive_da_compat Hda); auto.
@@ -147,24 +207,24 @@ simple refine {|
end in
let e := snd (proj1_sig (config id)) in
Rle_bool (threshold e) (current_ratio + da.(choose_inactive) (config_V2G config) id) |};
-try exact G; autoclass.
-Proof.
-+ intros config g. exists (proj1_sig (change_frame da (config_V2G config) g)).
- split; try reflexivity; []. apply proj2_sig.
-+ intros config g. exists (inverse (proj1_sig (change_frame da (config_V2G config) g))).
- split; try reflexivity; []. apply stable_threshold_inverse, proj2_sig.
-+ intros config1 config2 Hconfig gg g ?. subst gg. now rewrite Hconfig.
-+ intros config1 config2 Hconfig gg g ? pt1 pt2 Hpt.
- f_equiv; try apply Hpt; [].
- f_equiv. now apply (choose_update_compat da); f_equiv.
-+ intros config1 config2 Hconfig id1 id2 Hid. simpl in Hid. subst id1.
- assert (Hpt := Hconfig id2).
- destruct Hpt as [Hpt [[Hsrc Htgt] Hthd]],
- (proj1_sig (config1 id2)) as [pt1 e1],
- (proj1_sig (config2 id2)) as [pt2 e2].
- simpl in Hpt, Hsrc, Htgt, Hthd.
- destruct_match; simpl; rewrite Hthd; do 3 f_equiv;
- apply (choose_inactive_compat da); trivial; reflexivity.
+try exact TG; autoclass.
+Proof using .
+ + intros config g. exists (proj1_sig (change_frame da (config_V2G config) g)).
+ split; try reflexivity; []. apply proj2_sig.
+ + intros config g. exists (inverse (proj1_sig (change_frame da (config_V2G config) g))).
+ split; try reflexivity; []. apply stable_threshold_inverse, proj2_sig.
+ + intros config1 config2 Hconfig gg g ?. subst gg. now rewrite Hconfig.
+ + intros config1 config2 Hconfig gg g ? pt1 pt2 Hpt.
+ subst.
+ f_equiv.
+ * f_equiv.
+ now rewrite Hpt.
+ * f_equiv.
+ rewrite Hconfig.
+ now setoid_rewrite Hpt.
+ + intros config1 config2 Hconfig id1 id2 Hid. simpl in Hid. subst id1.
+ destruct (Cconfig id2) as [v1 e1 p1 | e1 p1]; cbn -[ratio_0];
+ now do 3 f_equiv; rewrite Hconfig.
Defined.
Instance da_C2D_compat : Proper (equiv ==> equiv ==> equiv) da_C2D.
@@ -219,7 +279,7 @@ intros ? ? Hconfig ? ? ? ? ? Hframe ? ? Htarget ? ? Hchoice.
simpl in Hchoice. subst. cbn zeta.
repeat destruct_match;
solve [ simpl; repeat split; apply Htarget
- | match goal with | H : complement _ _ _ |- _ => elim H end;
+ | match goal with | H : complement _ _ _ |- _ => contradiction H end;
simpl in Htarget; now (rewrite <- Hconfig, <- (proj1 (proj1 Htarget)))
|| (rewrite Hconfig, (proj1 (proj1 Htarget)))
| apply Hconfig ].
@@ -245,9 +305,9 @@ Defined.
Instance add_edge_compat : Proper (equiv ==> equiv ==> equiv ==> equiv) add_edge.
Proof using .
intros ? ? He Ï1 Ï1' HÏ1 Ï2 Ï2' HÏ2. unfold add_edge.
-Time repeat destruct_match; solve [ rewrite HÏ1, HÏ2 in *; contradiction
- | rewrite <- HÏ1, <- HÏ2 in *; contradiction
- | simpl; rewrite ?HÏ1, ?HÏ2; repeat split; apply He ].
+repeat destruct_match;
+try solve [hnf; split; apply He | apply proj_ratio_compat in HÏ1, HÏ2; congruence]; [].
+split; trivial; []. cbn. apply proj_ratio_compat in HÏ1, HÏ2. congruence.
Qed.
(** Move by a ratio [Ï] from the state [state]. *)
@@ -264,9 +324,9 @@ intros [v1 e1 proof1 | e1 p1] [v2 e2 proof2 | e2 p2] Heq Ï1 Ï2 HÏ; simpl in H
+ unfold move. destruct Heq as [Hv [[Hsrc Htgt] Hthd]].
do 2 destruct_match.
- now f_equiv.
- - match goal with H : complement _ _ _ |- _ => elim H end.
+ - match goal with H : complement _ _ _ |- _ => contradiction H end.
now rewrite <- Hv, <- Hsrc.
- - match goal with H : complement _ _ _ |- _ => elim H end.
+ - match goal with H : complement _ _ _ |- _ => contradiction H end.
now rewrite Hv, Hsrc.
- simpl. tauto.
+ unfold move. f_equiv; auto; []. now destruct p1, p2.
@@ -278,14 +338,24 @@ Proof. repeat intro. subst. now f_equiv. Defined.
Instance UpdateG : @update_function _ _ _ _ _ (sig stable_threshold) ratio
_ FrameChoiceIsomorphismG _.
-refine {|
- update := fun (config : CGF_config) g frame target Ï =>
- match config (Good g) with
- | SOnVertex v e proof =>
- if v =?= src target then move (SOnVertex v target ltac:(now left)) Ï else config (Good g)
- | SOnEdge e p => config (Good g)
- end |}.
Proof.
+ simpl in *.
+ unshelve refine {|
+ update := fun (config : CGF_config) g frame target Ï =>
+ match config (Good g) with
+ | SOnVertex v e proof => if v =?= src target then _ else config (Good g)
+ | SOnEdge e p => config (Good g)
+ end
+ |}; try typeclasses eauto.
+
+ { eapply move.
+ 2:exact Ï.
+ apply (SOnVertex v target).
+ left.
+ cbn.
+ simpl in *.
+ assumption. }
+
intros config1 config2 Hconfig gg g ? iso1 iso2 Hframe target1 target2 Htarget Ï1 Ï2 HÏ. subst gg.
assert (Hsrc := src_compat _ _ Htarget).
assert (Htgt := tgt_compat _ _ Htarget).
@@ -296,9 +366,9 @@ try destruct (v1 =?= src target1) as [Hsrc1 | Hsrc1],
(v2 =?= src target2) as [Hsrc2 | Hsrc2].
+ f_equiv; trivial; []. simpl.
rewrite Hsrc1, Hsrc2. repeat split; auto; apply Htarget.
-+ match goal with H : complement _ _ _ |- _ => elim H end.
++ match goal with H : complement _ _ _ |- _ => contradiction H end.
now rewrite <- Hsrc, <- (proj1 Hconfig).
-+ match goal with H : complement _ _ _ |- _ => elim H end.
++ match goal with H : complement _ _ _ |- _ => contradiction H end.
now rewrite Hsrc, (proj1 Hconfig).
+ assumption.
+ tauto.
@@ -371,25 +441,27 @@ simpl activate. destruct_match.
* cbn -[equiv precondition_satisfied]. rewrite Hconfig. simpl snd.
transitivity (iso_E Ciso e); [| transitivity (iso_E Diso e)].
+ f_equiv.
- + apply E_subrelation, (Isomorphism.iso_E_compat Hiso e).
+ + apply E_subrelation, Hiso.
+ repeat split.
- unfold equiv. cbn -[equiv].
now rewrite <- (proj1 (iso_morphism Diso e)), <- HDiso, (proj1 (iso_morphism _ e)).
- unfold equiv. cbn -[equiv].
now rewrite <- (proj2 (iso_morphism Diso e)), <- HDiso, (proj2 (iso_morphism _ e)).
- - unfold equiv. cbn -[equiv].
- rewrite <- 2 iso_threshold. unfold Diso. rewrite (proj2_sig Dframe_choice).
- destruct (precondition_satisfied da config g) as [? [? Ht]]. simpl. now rewrite Ht. }
+ - cbn. rewrite <- 2 iso_threshold. unfold Diso. rewrite (proj2_sig Dframe_choice).
+ destruct (precondition_satisfied da config g) as [? [? Ht]]. simpl. now rewrite Ht. }
assert (Hlocal_state : Clocal_state == state_V2G Dlocal_state).
{ unfold Clocal_state. rewrite Hlocal_config. reflexivity. }
assert (Hobs : Cobs == Dobs).
{ unfold Cobs, Dobs. unfold obs_from_config at 1. unfold obs_V2G.
rewrite Hlocal_config, Hlocal_state. reflexivity. }
assert (Hlocal_robot_decision : Clocal_robot_decision == Dlocal_robot_decision).
- { unfold Dlocal_robot_decision. cbn -[equiv]. rewrite Hobs. reflexivity. }
+ { unfold Dlocal_robot_decision. cbn -[equiv]. now apply (pgm_compat rbg). }
assert (Hchoice : Cchoice == if Dchoice then ratio_1 else ratio_0).
- { cbn -[equiv]. unfold Dchoice.
- rewrite Hlocal_config, config_V2G2V, Hobs. reflexivity. }
+ { cbn -[equiv]. unfold Dchoice, Dlocal_robot_decision.
+ apply config_G2V_compat in Hlocal_config. rewrite config_V2G2V in Hlocal_config.
+ destruct_match_eq Heq1; destruct_match_eq Heq2; reflexivity || exfalso;
+ apply Bool.diff_false_true; rewrite <- Heq1, <- Heq2; [ symmetry |];
+ apply (choose_update_compat da Hlocal_config (eq_refl g) _ _ (pgm_compat rbg _ _ Hobs)). }
assert (Hnew_local_state : Cnew_local_state == state_V2G Dnew_local_state).
{ unfold Cnew_local_state, Dnew_local_state. unfold update, UpdateG, UpdateV.
assert (Hlocal_g := Hlocal_config (Good g)). unfold config_V2G in Hlocal_g.
@@ -402,7 +474,8 @@ simpl activate. destruct_match.
(v =?= src Dlocal_robot_decision) as [Hv | Hv].
+ (* valid case: the robot chooses an adjacent edge *)
unfold move. destruct_match; try contradiction; [].
- rewrite Hchoice, Hlocal_robot_decision. destruct Dchoice.
+ rewrite (add_edge_compat Hlocal_robot_decision (reflexivity ratio_0) Hchoice).
+ destruct Dchoice.
- (* the demon lets the robot move *)
unfold add_edge. simpl equiv_dec.
destruct ((0 + 1)%R =?= 0%R); try (simpl in *; lra); [].
@@ -412,13 +485,13 @@ simpl activate. destruct_match.
- (* the demon does not let the robot move *)
unfold add_edge. simpl equiv_dec.
destruct ((0 + 0)%R =?= 0%R);
- try (match goal with H : complement _ _ _ |- _ => elim H; simpl in *; lra end); [].
+ try (match goal with H : complement _ _ _ |- _ => contradiction H; simpl in *; lra end); [].
simpl. repeat split; reflexivity.
+ (* absurd case: the robot does not make the same choice *)
- match goal with | H : complement _ _ _ |- _ => elim H end.
+ match goal with | H : complement _ _ _ |- _ => contradiction H end.
rewrite <- Heqv, Hv'. apply Hlocal_robot_decision.
+ (* absurd case: the robot does not make the same choice *)
- match goal with | H : complement _ _ _ |- _ => elim H end.
+ match goal with | H : complement _ _ _ |- _ => contradiction H end.
rewrite Heqv, Hv. symmetry. apply Hlocal_robot_decision.
+ (* invalid case: the robot does not choose an adjacent edge *)
simpl. repeat split; apply Heqv || apply Heqe. }
@@ -443,13 +516,13 @@ simpl activate. destruct_match.
unfold liftG. cbn [projT2]. repeat split.
- rewrite HCiso'. cbn. f_equiv. symmetry. apply Hiso.
- unfold equiv. cbn -[equiv precondition_satisfied_inv].
- Time setoid_rewrite <- (proj1 (iso_morphism _ e)).
- Time setoid_rewrite HCiso'.
+ setoid_rewrite <- (proj1 (iso_morphism _ e)).
+ setoid_rewrite HCiso'.
transitivity (inverse Diso (src e)); try apply HDiso'; [].
f_equiv. apply inverse_compat. now symmetry.
- unfold equiv. cbn -[equiv precondition_satisfied_inv].
- Time setoid_rewrite <- (proj2 (iso_morphism _ e)).
- Time setoid_rewrite HCiso'.
+ setoid_rewrite <- (proj2 (iso_morphism _ e)).
+ setoid_rewrite HCiso'.
transitivity (inverse Diso (tgt e)); try apply HDiso'; [].
f_equiv. apply inverse_compat. now symmetry.
- hnf. rewrite <- 2 iso_threshold.
@@ -479,7 +552,7 @@ simpl activate. destruct_match.
- (* the demon chooses not to let the robot move *)
unfold add_edge. simpl.
destruct ((0 + 0)%R =?= 0%R);
- try (match goal with H : complement _ _ _ |- _ => elim H; simpl in *; lra end); [].
+ try (match goal with H : complement _ _ _ |- _ => contradiction H; simpl in *; lra end); [].
repeat split; assumption || reflexivity.
+ unfold valid_stateV in *. simpl in Hvalid.
destruct Hvalid as [ | Hvalid]; try contradiction; [].
@@ -551,9 +624,9 @@ simpl activate. destruct_match_eq Hactive.
assert (HDiso : projT1 (precondition_satisfied (da_C2D da config) (config_G2V config) g) == Diso).
{ destruct (precondition_satisfied (da_C2D da config) (config_G2V config) g)
as [Diso' [HDf HDt]] eqn:HDiso. simpl projT1.
- pose (iso_OKV := fun f (iso : @isomorphism (@location LocationV) E G) =>
+ pose (iso_OKV := fun f (iso : @threshold_isomorphism (@location LocationV) E TG) =>
frame_choice_bijection f == iso.(iso_V)
- /\ iso_T iso == @Bijection.id R R_Setoid).
+ /\ iso_T iso == Bijection.id).
change (projT1 (existT (iso_OKV _) Diso' (conj HDf HDt)) == proj1_sig Dframe_choice).
fold (iso_OKV (change_frame (da_C2D da config) (config_G2V config) g)) in HDiso.
change (precondition_satisfied (da_C2D da config) (config_G2V config) g =
@@ -573,25 +646,21 @@ simpl activate. destruct_match_eq Hactive.
simpl state_G2V. repeat split.
+ simpl fst. rewrite Hframe. unfold config_G2V.
transitivity (Ciso v); reflexivity || now symmetry; apply (HCiso (OnVertex v)).
- + cbn -[precondition_satisfied].
- rewrite <- 2 (proj1 (iso_morphism _ _)),
- (iso_V_compat HDiso (src e)),
- (iso_V_compat Hiso (src e)).
- symmetry. apply (HCiso (OnVertex (src e))).
- + cbn -[precondition_satisfied].
- rewrite <- 2 (proj2 (iso_morphism _ _)),
- (iso_V_compat HDiso (tgt e)),
- (iso_V_compat Hiso (tgt e)).
- symmetry. apply (HCiso (OnVertex (tgt e))).
+ + cbn-[precondition_satisfied]. rewrite <- 2 (proj1 (iso_morphism _ _)).
+ etransitivity. 2: symmetry; apply (HCiso (OnVertex (src e))).
+ etransitivity. 2: apply Hiso. apply HDiso.
+ + cbn-[precondition_satisfied]. rewrite <- 2 (proj2 (iso_morphism _ _)).
+ etransitivity. 2: symmetry; apply (HCiso (OnVertex (tgt e))).
+ etransitivity. 2: apply Hiso. apply HDiso.
+ cbn -[precondition_satisfied]. rewrite <- 2 iso_threshold.
now rewrite (proj2 (projT2 (precondition_satisfied da config g))),
(proj2 (projT2 (precondition_satisfied (da_C2D da config) (config_G2V config) g))).
* (* OnEdge *)
simpl liftG. simpl state_G2V.
- assert (Heq : threshold ((iso_E (projT1 (precondition_satisfied da config g))) e) = threshold e).
+ assert (Heq : threshold ((iso_E (projT1 (precondition_satisfied da config g))) e) == threshold e).
{ now rewrite <- iso_threshold, (proj2 (projT2 (precondition_satisfied da config g))). }
- destruct (Rle_dec (threshold e) p);
- destruct_match; try (rewrite <- Heq in *; contradiction); [|].
+ destruct (Rle_dec (threshold e) p); destruct_match; repeat rewrite proj_ratio_strict_ratio in *;
+ try (hnf in Heq; rewrite <- Heq in *; contradiction); [|].
+ (* we are after the threshold, g is seen at the target of the edge *)
cbn -[precondition_satisfied]. repeat split.
- rewrite <- (proj2 (iso_morphism _ _)).
@@ -634,15 +703,17 @@ simpl activate. destruct_match_eq Hactive.
{ unfold Cobs, Dobs. unfold obs_from_config at 2. unfold obs_V2G.
rewrite Hlocal_config, Hlocal_state. reflexivity. }
assert (Hlocal_robot_decision : Dlocal_robot_decision == Clocal_robot_decision).
- { unfold Dlocal_robot_decision. cbn -[equiv]. rewrite Hobs. reflexivity. }
+ { unfold Clocal_robot_decision, Dlocal_robot_decision. now apply (pgm_compat rbg). }
assert (Hchoice : Dchoice == if Rle_dec (threshold Clocal_robot_decision) Cchoice
then true else false).
- { unfold Dchoice, choose_update, da_C2D.
- rewrite Hlocal_config, Hchoose_update. rewrite Hlocal_robot_decision at 2.
- assert (Hthd := proj2 Hlocal_robot_decision). hnf in Hthd. rewrite Hthd.
- destruct (Rle_dec (threshold Clocal_robot_decision) Cchoice) as [Hle | Hlt].
- - rewrite <- Rle_bool_true_iff in Hle. apply Hle.
- - rewrite <- Rle_bool_false_iff in Hlt. apply Hlt. }
+ { unfold Dchoice, choose_update, da_C2D, Rle_bool.
+ do 2 destruct_match; try reflexivity; [|]; exfalso;
+ revert_one not; revert_one Rle; repeat rewrite proj_ratio_strict_ratio;
+ assert (Heq := proj1_sig_compat equiv_dec _ _ (threshold_compat _ _ Hlocal_robot_decision));
+ hnf in Heq; rewrite Heq, Hlocal_config;
+ rewrite (proj_ratio_compat _ _ (Hchoose_update Clocal_config g Dlocal_robot_decision)),
+ (proj_ratio_compat _ _ (choose_update_compat da (reflexivity _) (eq_refl g) _ _ Hlocal_robot_decision));
+ unfold Cchoice; congruence. }
assert (HCiso' : forall v, projT1 (precondition_satisfied_inv da config g) v == inverse Ciso v).
{ destruct (precondition_satisfied_inv da config g)as [Ciso' [HCf HCt]].
simpl projT1. intro v.
@@ -652,9 +723,17 @@ simpl activate. destruct_match_eq Hactive.
== iso_E (inverse Ciso) e).
{ destruct (precondition_satisfied_inv da config g)as [Ciso' [HCf HCt]].
simpl projT1. intro e.
- cut (bijectionG Ciso' (OnEdge e (1 /sr 2)) == bijectionG (inverse Ciso) (OnEdge e (1 /sr 2)));
- try (now intros [Heq _]); [].
- rewrite <- (HCf (OnEdge e (1 /sr 2))). reflexivity. }
+ (* why does this stopped working between coq-8.16 and 8.19? *)
+ (* cut ((bijectionG Ciso' (OnEdge e (1 /sr 2))) == (bijectionG (inverse Ciso) (OnEdge e (1 /sr 2)))). *)
+ pose (hsim := @bijectionG V E TG (inverse Ciso)).
+
+ assert (@equiv (@loc V E TG) locG_Setoid
+ (@bijectionG V E TG Ciso' (@OnEdge V E TG e (1 /sr 2)))
+ (@hsim (@OnEdge V E TG e (1 /sr 2)) )).
+ { rewrite <- (HCf (@OnEdge V E TG e (1 /sr 2))).
+ reflexivity. }
+ destruct H.
+ assumption. }
assert (HnotOnEdge : forall e p, Clocal_config (Good g) =/= SOnEdge e p).
{ intros e0 p0 H0.
destruct (Clocal_config (Good g)) as [| e p] eqn:Habs; try tauto; [].
@@ -680,41 +759,54 @@ simpl activate. destruct_match_eq Hactive.
assert (Hnew_local_state : Dnew_local_state == state_G2V Cnew_local_state).
{ unfold Cnew_local_state, Dnew_local_state. unfold update, UpdateG, UpdateV.
assert (Hlocal_g := Hlocal_config (Good g)). unfold config_G2V in Hlocal_g.
- destruct (Clocal_config (Good g)) as [v e proof | e p] eqn:Hg;
- try (exfalso; apply (HnotOnEdge _ _ (reflexivity _))); [].
+ destruct (Clocal_config (Good g)) as [v e proof | e p] eqn:Hg.
+ 2:(exfalso; apply (HnotOnEdge _ _ (reflexivity _))).
(* the robot is on a vertex *)
apply get_location_compat in Hlocal_g.
unfold state_G2V in Hlocal_g.
simpl get_location in Hlocal_g at 2.
unfold move. simpl fst. symmetry.
do 2 destruct_match.
+ rename H into h.
+ rename H0 into h0.
* (* valid case: the robot chooses an adjacent edge *)
- rewrite Hchoice. unfold add_edge.
- destruct_match; [| destruct_match]; simpl state_G2V.
- + (* the robot will not move so will end up in its starting position *)
- assert (Hproj_choice : proj_ratio Cchoice = 0%R).
- { assert (Hbounds := ratio_bounds Cchoice). simpl in *; lra. }
+ revert Hchoice. destruct_match; intro Hchoice; hnf in Hchoice; rewrite Hchoice;
+ unfold add_edge; (destruct_match; [| destruct_match]); simpl state_G2V.
+ + (* absurd case *)
+ assert (hratio_0: proj_ratio Cchoice = 0%R).
+ { assert (Hbounds := ratio_bounds Cchoice). cbn in *; lra. }
assert (proj_ratio Cchoice < threshold Clocal_robot_decision)%R.
- { rewrite Hproj_choice. apply threshold_pos. }
- destruct_match; try lra; []. symmetry. split; apply Hlocal_robot_decision.
+ { rewrite hratio_0. apply strict_ratio_bounds. }
+ lra.
+ (* the robot reaches its destination *)
change (proj_ratio ratio_0) with 0%R in *. rewrite Rplus_0_l in *.
- assert (threshold Clocal_robot_decision <= proj_ratio Cchoice)%R.
- { transitivity 1; trivial; []. apply Rlt_le. apply threshold_pos. }
- destruct_match; try lra; [].
symmetry. hnf. simpl fst. simpl snd. split; apply Hlocal_robot_decision.
+ (* the robot moves and ends up on the edge *)
rewrite Rplus_0_l in *.
- destruct_match.
- - (* the ending point is after the edge threshold *)
- symmetry. repeat split; simpl; apply Hlocal_robot_decision.
+ destruct_match; try contradiction; [].
+ (* the ending point is after the edge threshold *)
+ symmetry. repeat split; simpl; apply Hlocal_robot_decision.
+ + (* the robot will not move so will end up in its starting position *)
+ assert (hratio0 : proj_ratio Cchoice = 0%R).
+ { assert (Hbounds := ratio_bounds Cchoice). cbn in *; lra. }
+ assert (proj_ratio Cchoice < threshold Clocal_robot_decision)%R.
+ { rewrite hratio0. apply strict_ratio_bounds. }
+ symmetry. split; cbn -[equiv]; apply Hlocal_robot_decision.
+ + (* absurd case *)
+ exfalso. change (proj_ratio ratio_0) with 0%R in *. rewrite Rplus_0_l in *.
+ assert (threshold Clocal_robot_decision <= proj_ratio Cchoice)%R.
+ { transitivity 1; trivial; []. apply Rlt_le. apply strict_ratio_bounds. }
+ contradiction.
+ + (* the robot moves and ends up on the edge *)
+ rewrite Rplus_0_l in *.
+ destruct_match; try contradiction; [].
- (* the ending point is before the edge threshold *)
symmetry. repeat split; simpl; apply Hlocal_robot_decision.
* (* absurd case: the robot does not make the same choice *)
- match goal with | H : complement _ _ _ |- _ => elim H end.
+ match goal with | H : complement _ _ _ |- _ => contradiction H end.
rewrite Hlocal_g. etransitivity; eauto. symmetry. apply Hlocal_robot_decision.
* (* absurd case: the robot does not make the same choice *)
- match goal with | H : complement _ _ _ |- _ => elim H end.
+ match goal with | H : complement _ _ _ |- _ => contradiction H end.
rewrite <- Hlocal_g. etransitivity; eauto. apply Hlocal_robot_decision.
* (* invalid case: the robot does not choose an adjacent edge *)
rewrite Hlocal_config, <- Hg. reflexivity. }
@@ -735,15 +827,13 @@ simpl activate. destruct_match_eq Hactive.
change (Bijection.retraction (iso_E Diso)) with (Bijection.section (iso_E (inverse Diso))).
symmetry. etransitivity; try apply (iso_E_compat (inverse Ciso)), He; [].
apply E_subrelation. f_equiv.
- apply Isomorphism.iso_E_compat. clear -Hiso. now apply inverse_compat.
+ apply Isomorphism.iso_E_compat. clear -Hiso. apply inverse_compat, Hiso.
-- simpl snd. etransitivity; try apply HCisoE; [].
change (Bijection.retraction (iso_E Diso)) with (Bijection.section (iso_E (inverse Diso))).
symmetry. etransitivity; try apply (iso_E_compat (inverse Ciso)), He; [].
- apply E_subrelation. f_equiv.
- now apply Isomorphism.iso_E_compat, inverse_compat.
- -- unfold equiv. cbn -[equiv Dnew_local_state inverse].
- change (iso_E Diso â»Â¹) with (iso_E (Diso â»Â¹)).
- rewrite <- 2 iso_threshold.
+ apply E_subrelation. f_equiv. apply Isomorphism.iso_E_compat, inverse_compat, Hiso.
+ -- cbn-[Dnew_local_state IsoInverse]. change ((iso_VE Diso)â»Â¹) with (iso_VE (Diso â»Â¹)).
+ rewrite <-2 iso_threshold.
rewrite (proj2 (projT2 (precondition_satisfied_inv da config g))),
(proj2 (projT2 (precondition_satisfied_inv (da_C2D da config) (config_G2V config) g))).
now rewrite He.
@@ -751,22 +841,15 @@ simpl activate. destruct_match_eq Hactive.
destruct Dnew_local_state as [[v' e'] Hvalid].
unfold state_G2V in *. simpl liftG. cbn iota beta. simpl snd.
assert (Htest : threshold
- (Bijection.section (iso_E (projT1 (precondition_satisfied_inv da config g))) e) = threshold e)
+ (Bijection.section (iso_E (projT1 (precondition_satisfied_inv da config g))) e) == threshold e)
by now rewrite <- iso_threshold, (proj2 (projT2 (precondition_satisfied_inv da config g))).
Time destruct (Rle_dec (threshold e) p) as [Hle | Hlt].
++ destruct Hnew_local_state as [Hv He]. simpl fst in Hv. simpl snd in He.
(* destruct takes too long... *)
assert (threshold (Bijection.section (iso_E (projT1 (precondition_satisfied_inv da config g))) e)
- <= proj_ratio (proj_strict_ratio p)) by now rewrite Htest.
-
- (* too slow, case is faster *)
- (* Time destruct_match; try contradiction; []. (* 230 sec!!!! *) *)
- Time match goal with
- | |- (match ?x with | _ => _ end) == _ => case x
- end.
- all:swap 1 2.
- { intros notH.
- apply (absurd _ H);assumption. }
+ <= proj_ratio (proj_strict_ratio p)).
+ { hnf in Htest. rewrite proj_ratio_strict_ratio in *. now rewrite Htest. }
+ destruct_match; try contradiction; [].
split; simpl fst; simpl snd.
-- transitivity (tgt (Bijection.section (iso_E (inverse Ciso)) e)); [apply HCisoE |].
rewrite Hv, <- (proj2 (iso_morphism _ e)). cbn -[equiv].
@@ -778,15 +861,9 @@ simpl activate. destruct_match_eq Hactive.
symmetry. apply E_subrelation, Hiso.
++ destruct Hnew_local_state as [Hv He]. simpl fst in Hv. simpl snd in He.
assert (¬ threshold (Bijection.section (iso_E (projT1 (precondition_satisfied_inv da config g))) e)
- <= proj_ratio (proj_strict_ratio p)) by now rewrite Htest.
-
- (* too slow, case is faster *)
- (* Time destruct_match; try contradiction; []. (* 230 sec!!!! *) *)
- Time match goal with
- | |- (match ?x with | _ => _ end) == _ => case x
- end.
- { intros notH.
- apply (absurd _ notH);assumption. }
+ <= proj_ratio (proj_strict_ratio p)).
+ { hnf in Htest. rewrite proj_ratio_strict_ratio in *. now rewrite Htest. }
+ destruct_match; try contradiction; [].
split; simpl fst; simpl snd.
-- rewrite <- (proj1 (iso_morphism _ _)), Hv.
transitivity (Bijection.section (iso_V (inverse Ciso)) (src e)); [apply HCiso' |].
@@ -805,9 +882,8 @@ simpl activate. destruct_match_eq Hactive.
cbn -[equiv equiv_dec]. destruct_match.
- (* the robot is at the edge src *)
unfold add_edge, state_G2V.
- assert (He := threshold_pos e). rewrite Hchoose_inactive.
- change (proj_ratio ratio_0) with 0. rewrite Rplus_0_l at 2.
- destruct (Rle_bool (threshold e) (proj_ratio (choose_inactive da config id))) eqn:Htest;
+ assert (He := strict_ratio_bounds (threshold e)). rewrite (proj_ratio_compat _ _ (Hchoose_inactive id)).
+ change (proj_ratio ratio_0) with 0. symmetry. destruct_match_eq Htest;
rewrite Rle_bool_true_iff in Htest || rewrite Rle_bool_false_iff in Htest;
repeat destruct_match; try (now split; auto);
simpl in * |-; try rewrite Rplus_0_l in *; contradiction || lra.
@@ -817,7 +893,7 @@ simpl activate. destruct_match_eq Hactive.
+ (* the robot is on an edge *)
cbn -[equiv]. destruct_match; cbn -[equiv].
- (* the robot is already past the edge threshold *)
- assert (He := threshold_pos e).
+ assert (He := strict_ratio_bounds (threshold e)).
assert (Hp := ratio_bounds (choose_inactive da config id)).
transitivity (exist valid_stateV (tgt e, e) (or_intror (reflexivity (tgt e))));
[| now repeat destruct_match].
@@ -830,11 +906,11 @@ simpl activate. destruct_match_eq Hactive.
assert (Hp := strict_ratio_bounds p).
intro Habs. simpl in Habs. lra. }
destruct_match; try contradiction; [].
- rewrite Hchoose_inactive.
+ rewrite (proj_ratio_compat _ _ (Hchoose_inactive id)).
destruct (Rle_bool (threshold e) (p + choose_inactive da config id)) eqn:Hcase;
rewrite Rle_bool_true_iff in Hcase || rewrite Rle_bool_false_iff in Hcase;
repeat destruct_match; try solve [split; reflexivity | simpl in *; contradiction]; [].
- elim Hcase. transitivity 1; trivial; []. apply Rlt_le. apply threshold_pos.
+ contradiction Hcase. transitivity 1; trivial; []. apply Rlt_le. apply strict_ratio_bounds.
Qed.
End GraphEquivalence.
diff --git a/Models/NoByzantine.v b/Models/NoByzantine.v
index 977fbbc9edd6ae9c62cd30a6ad38d1fcb8e9c83d..5e99c0b73ca084ce49970cac62683a55bc49cd08 100644
--- a/Models/NoByzantine.v
+++ b/Models/NoByzantine.v
@@ -1,32 +1,54 @@
-Require Import SetoidClass.
-Require Import Pactole.Core.Identifiers.
-Require Import Pactole.Core.State.
-Require Import Pactole.Core.Configuration.
+Require Import Utf8 SetoidClass.
+From Pactole Require Import Core.Identifiers Core.State Core.Configuration.
(** To use these results, just provide an instance of the [NoByzantine] class. *)
Section NoByzantine.
-Context `{Names}.
-Context `{St : State}.
+Context {N : Names}.
+Context {L : Location} {info : Type} {St : State info}.
Class NoByzantine := { nB_eq_0 : nB = 0 }.
Context {NoByz : NoByzantine}.
+
(** There is no byzantine robot so we can simplify properties
about identifiers and configurations. *)
-Lemma no_byz : forall (id : ident) P, (forall g, P (Good g)) -> P id.
+
+Lemma Bnames_nil : Bnames = nil.
+Proof using NoByz.
+ now rewrite <- List.length_zero_iff_nil, Bnames_length, nB_eq_0.
+Qed.
+
+Lemma no_byz : ∀ (id : ident) (P : ident -> Type), (∀ g, P (Good g)) -> P id.
+Proof using NoByz.
+ intros [g | b] P HP. { apply HP. } exfalso. apply (@List.in_nil _ b).
+ rewrite <- Bnames_nil. apply In_Bnames.
+Qed.
+
+Lemma no_byz_inv : ∀ (P : ident -> Type),
+ (∀ id : ident, P id) -> ∀ g, P (Good g).
+Proof using . intros * H *. apply H. Qed.
+
+Lemma no_byz_eq : ∀ config1 config2 : configuration,
+ (∀ g, config1 (Good g) == config2 (Good g)) -> config1 == config2.
+Proof using NoByz.
+ intros config1 config2 Heq id. apply (no_byz id). intro g. apply Heq.
+Qed.
+
+Lemma no_byz_fun {T : Type} : B -> T.
Proof using NoByz.
-intros [g | b] P HP.
-+ apply HP.
-+ assert (Hnil : Bnames = nil) by now rewrite <- List.length_zero_iff_nil, Bnames_length, nB_eq_0.
- elim (@List.in_nil _ b). rewrite <- Hnil. apply In_Bnames.
+ intros b. exfalso. apply (@List.in_nil B b). rewrite <- Bnames_nil.
+ apply In_Bnames.
Qed.
-Lemma no_byz_eq : forall config1 config2 : configuration,
- (forall g, config1 (Good g) == config2 (Good g)) -> config1 == config2.
+Lemma no_byz_ex : ∀ (P : ident → Prop),
+ (∃ id : ident, P id) <-> (∃ g : G, P (Good g)).
Proof using NoByz.
-intros config1 config2 Heq id. apply (no_byz id). intro g. apply Heq.
+ intros. split.
+ - intros [[g | b] H]. { exists g. apply H. } exfalso.
+ apply (@List.in_nil B b). rewrite <- Bnames_nil. apply In_Bnames.
+ - intros [g H]. exists (Good g). apply H.
Qed.
End NoByzantine.
diff --git a/Models/RigidFlexibleEquivalence.v b/Models/RigidFlexibleEquivalence.v
index 98077dfc007a5408192e0eb40fb067ca5344c780..282b2cee0a9ba43d9016bd55b9649ea7b742c837 100644
--- a/Models/RigidFlexibleEquivalence.v
+++ b/Models/RigidFlexibleEquivalence.v
@@ -24,6 +24,7 @@ Require Import Reals Psatz.
Require Import Pactole.Setting.
Require Import Pactole.Spaces.RealMetricSpace.
Require Import Pactole.Spaces.Similarity.
+Require Import Pactole.Util.Bijection.
Require Pactole.Models.Rigid.
Require Pactole.Models.Flexible.
diff --git a/Models/RingSSync.v b/Models/RingSSync.v
new file mode 100644
index 0000000000000000000000000000000000000000..d3752a1540185656436c7de65550987b6c03be6c
--- /dev/null
+++ b/Models/RingSSync.v
@@ -0,0 +1,37 @@
+Require Import Utf8.
+From Pactole Require Export Setting Spaces.Graph Util.Bijection
+ Spaces.Isomorphism Util.Fin Spaces.Ring Observations.MultisetObservation.
+
+Set Implicit Arguments.
+
+Section RingSSync.
+
+Context {n : nat} {ltc_2_n : 2 <c n} {Robots : Names}.
+
+Global Existing Instance NodesLoc.
+
+Global Instance St : State location := OnlyLocation (fun _ => True).
+
+Global Existing Instance multiset_observation.
+
+Global Instance RC : robot_choice direction :=
+ { robot_choice_Setoid := direction_Setoid }.
+
+(** Demon's frame choice:
+ we move back the robot to the origin with a translation
+ and we can choose the orientation of the ring. *)
+Global Instance FC : frame_choice (location * bool) := {
+ frame_choice_bijection :=
+ λ nb, if snd nb then (trans (fst nb)) ∘ (sym (fst nb))
+ else trans (fst nb);
+ frame_choice_Setoid := eq_setoid _ }.
+
+Global Existing Instance NoChoice.
+Global Existing Instance NoChoiceIna.
+Global Existing Instance NoChoiceInaFun.
+
+Global Instance UpdFun : update_function direction (location * bool) unit := {
+ update := λ config g _ dir _, move_along (config (Good g)) dir;
+ update_compat := ltac:(repeat intro; subst; now apply move_along_compat) }.
+
+End RingSSync.
diff --git a/Observations/Definition.v b/Observations/Definition.v
index 69151d2e93a4ea3f0636596e6318cf84efafdb9e..424f97353726bee8fee2ac46dd54ba7836904cec 100644
--- a/Observations/Definition.v
+++ b/Observations/Definition.v
@@ -30,7 +30,7 @@ Class Observation {info} `{State info} `{Names} := {
obs_is_ok : observation -> configuration -> info -> Prop;
obs_from_config_spec : forall config st, obs_is_ok (obs_from_config config st) config st }.
-Existing Instance observation_Setoid.
-Existing Instance observation_EqDec.
-Existing Instance obs_from_config_compat.
+Global Existing Instance observation_Setoid.
+Global Existing Instance observation_EqDec.
+Global Existing Instance obs_from_config_compat.
Arguments obs_from_config : simpl never.
diff --git a/Observations/LimitedMultisetObservation.v b/Observations/LimitedMultisetObservation.v
index ee35ad67c2aa44532d5ff1d3185e78c0b8d1bbae..2fc98cc07d6b32a2ca64ab901160daad01972440 100644
--- a/Observations/LimitedMultisetObservation.v
+++ b/Observations/LimitedMultisetObservation.v
@@ -23,6 +23,7 @@ Require Import Lia.
Require Import SetoidList.
Require Import SetoidDec.
Require Import Rbase.
+Require Import Pactole.Util.Bijection.
Require Import Pactole.Util.FMaps.FMapList.
Require Import Pactole.Util.MMultiset.MMultisetWMap.
Require Export Pactole.Util.MMultiset.MMultisetInterface.
@@ -41,8 +42,6 @@ Require Import Pactole.Spaces.Similarity.
Close Scope R_scope.
Set Implicit Arguments.
-Coercion Bijection.section : Bijection.bijection >-> Funclass.
-
Section MultisetObservation.
diff --git a/Observations/LimitedSetObservation.v b/Observations/LimitedSetObservation.v
index d530d54229535d5f68e4898e2d7740b297ff1145..d147a81de8f3742089e2b852481e86df171531da 100644
--- a/Observations/LimitedSetObservation.v
+++ b/Observations/LimitedSetObservation.v
@@ -22,6 +22,7 @@ Require Import SetoidDec.
Require Import Rbase.
Require Import Pactole.Util.FSets.FSetInterface.
Require Import Pactole.Util.FSets.FSetFacts.
+Require Import Pactole.Util.Bijection.
Require Import Pactole.Util.Coqlib.
Require Import Pactole.Core.Identifiers.
Require Import Pactole.Core.State.
@@ -30,7 +31,6 @@ Require Import Pactole.Observations.Definition.
Require Import Pactole.Spaces.RealMetricSpace.
Require Import Pactole.Spaces.Similarity.
Require Pactole.Observations.SetObservation.
-Coercion Bijection.section : Bijection.bijection >-> Funclass.
Section LimitedSetObservation.
@@ -75,7 +75,7 @@ Lemma obs_from_config_map : forall radius (sim : similarity location),
Proof using .
repeat intro. unfold obs_from_config, limited_set_observation.
rewrite config_list_map; try (now apply lift_compat; simpl; apply Bijection.section_compat); [].
-rewrite map_map, 2 filter_map, <- SetObservation.make_set_map, map_map; autoclass; [].
+rewrite map_map, 2 filter_map, <- SetObservation.make_set_map, map_map; autoclass.
apply SetObservation.make_set_compat, eqlistA_PermutationA_subrelation.
assert (Hequiv : (@equiv _ state_Setoid ==> @equiv _ location_Setoid)%signature
(fun x => sim (get_location x)) (fun x => get_location (lift (existT precondition sim Psim) x))).
diff --git a/Observations/MultisetObservation.v b/Observations/MultisetObservation.v
index 4aa26b63832b8f5b73e160ebbddb2c66747b7efa..73b74e3f98ef4f6530de357a6a6fab4ac5c51305 100644
--- a/Observations/MultisetObservation.v
+++ b/Observations/MultisetObservation.v
@@ -79,7 +79,7 @@ rewrite make_multiset_cons in Hin. destruct (equiv_dec x a) as [Heq | Heq].
+ rewrite equiv_dec_refl in Hin.
lia.
+ rewrite equiv_dec_refl in Hin.
- rewrite plus_comm in Hin. cbn in Hin. apply eq_add_S, IHl in Hin. destruct Hin as [l' [Hl1 Hl2]].
+ rewrite Nat.add_comm in Hin. cbn in Hin. apply eq_add_S, IHl in Hin. destruct Hin as [l' [Hl1 Hl2]].
exists l'. split. assumption. simpl. now constructor.
- rewrite add_other in Hin; auto. apply IHl in Hin. destruct Hin as [l' [Hl1 Hl2]].
exists (a :: l'). split. intro Hin; inversion_clear Hin; contradiction.
@@ -93,7 +93,7 @@ intros x n. induction n.
+ simpl alls. rewrite make_multiset_cons. rewrite IHn. intro y. rewrite singleton_spec.
destruct (equiv_dec y x) as [Heq | Heq].
- rewrite Heq, add_spec, singleton_spec.
- destruct (equiv_dec x x) as [_ | Helim]. lia. now elim Helim.
+ destruct (equiv_dec x x) as [_ | Helim]. lia. now contradiction Helim.
- rewrite add_other; auto. rewrite singleton_spec.
destruct (equiv_dec y x); trivial; []. contradiction.
Qed.
@@ -210,7 +210,6 @@ rewrite config_list_map, map_map, <- make_multiset_map, map_map.
{ intros pt1 pt2 Heq. now rewrite get_location_lift, Heq. }
now apply (map_extensionalityA_compat _ Hequiv).
+ assumption.
-+ now apply lift_compat.
Qed.
Theorem cardinal_obs_from_config : forall config pt, cardinal (obs_from_config config pt) = nG + nB.
diff --git a/Observations/MultisetObservationInfo.v b/Observations/MultisetObservationInfo.v
index e025140d10d325ecc43c35b74c5489521e51ab60..7529b07c4d5807922081c43a1bd407c1d2028d61 100644
--- a/Observations/MultisetObservationInfo.v
+++ b/Observations/MultisetObservationInfo.v
@@ -79,7 +79,7 @@ rewrite make_multiset_cons in Hin. destruct (equiv_dec x a) as [Heq | Heq].
+ rewrite equiv_dec_refl in Hin.
lia.
+ rewrite equiv_dec_refl in Hin.
- rewrite plus_comm in Hin. cbn in Hin. apply eq_add_S, IHl in Hin. destruct Hin as [l' [Hl1 Hl2]].
+ rewrite Nat.add_comm in Hin. cbn in Hin. apply eq_add_S, IHl in Hin. destruct Hin as [l' [Hl1 Hl2]].
exists l'. split. assumption. simpl. now constructor.
- rewrite add_other in Hin; auto. apply IHl in Hin. destruct Hin as [l' [Hl1 Hl2]].
exists (a :: l'). split. intro Hin; inversion_clear Hin; contradiction.
@@ -222,7 +222,6 @@ Proof using .
now rewrite Heq. }
now apply (map_extensionalityA_compat _ Hequiv).
+ assumption.
-+ now apply lift_compat.
Qed.
Theorem cardinal_obs_from_config : forall config pt, cardinal (obs_from_config config pt) = nG + nB.
diff --git a/Observations/SetObservation.v b/Observations/SetObservation.v
index 21052c66e32e99f8c9d3ffa0309bcf4a49328a08..dc3bcf01b91d31adde53e30415861f1ccce0290f 100644
--- a/Observations/SetObservation.v
+++ b/Observations/SetObservation.v
@@ -101,7 +101,7 @@ intros x l. induction l as [| e l].
* destruct IHl as [l' [n [Hin Hperm]]]. destruct (e =?= x) as [Heq | Heq].
+ exists l', (S n). split; trivial. simpl. apply PermutationA_cons; assumption.
+ exists (e :: l'), n. split.
- - intro Habs. inversion_clear Habs. elim Heq. now symmetry. contradiction.
+ - intro Habs. inversion_clear Habs. apply Heq. now symmetry. contradiction.
- rewrite Hperm. apply (PermutationA_middle _).
Qed.
@@ -204,7 +204,6 @@ rewrite config_list_map, map_map, <- make_set_map, map_map.
{ intros pt1 pt2 Heq. now rewrite get_location_lift, Heq. }
now apply (map_extensionalityA_compat _ Hequiv).
+ assumption.
-+ now apply lift_compat.
Qed.
Theorem cardinal_obs_from_config : forall config state,
diff --git a/README.md b/README.md
index 11494d903fcb8ad3406dcaae025ced4a083efeb5..0b2dc291d766b0c890439a36830a2cb4b55dca36 100644
--- a/README.md
+++ b/README.md
@@ -1,5 +1,25 @@
-This repository stores the Coq code of the Pactole project,
-dedicated to formal verification of mobile robotic swarm protocols.
+# Content
+
+This repository stores the Coq code of the Pactole
+(https://pactole.liris.cnrs.fr/) project, dedicated to formal
+verification of mobile robotic swarm protocols in many variants of the
+model initially proposed by Suzuki and Yamashita [1] and sometimes
+called the "look-compute-move model".
+
+It contains a very abstract and parametrized formal model and a lot of
+case studies. The structure of the repository is describe below.
+
+# Support
+
+It was financially supported by the following propject:
+
+- [The Pactole project](https://pactole.liris.cnrs.fr/) started as
+ Digiteo Project #2009-38HD.
+- [SAPPORO](https://sapporo.liris.cnrs.fr/) is funded by the French
+ National Research Agency (ANR) under the reference 2019-CE25-0005
+
+[1] I. Suzuki and M. Yamashita. Distributed Anonymous Mobile Robots: Formation
+ of Geometric Patterns. SIAM Journal of Computing, 28(4):1347–1363, 1999.
# Overall Structure
@@ -9,87 +29,72 @@ dedicated to formal verification of mobile robotic swarm protocols.
- *Spaces/*: Spaces in which robots evolve
- *Observations/*: Types of robot views of the configuration
- *Models/*: Additional properties of some models
-- *CasesStudies/*
- - *Convergence/*: Convergence of robots in the 2D Euclidean plane
- - *Gathering/*: Gathering in R or R² for various models
- - *Exploration/*: Exploration of a ring with stop
- - *LifeLine/*: Life line connection in the 2D Euclidean plane
-
-# Fast Compiling when developing
-
-During development you can benefit from coq's "vos/vok" generation to
-speed up compilation. The only specificity of Pactole concerns
-compilation of the files named xxx_Assumptions.v. This files print the
-sets of assumptions used in the proofs of final lemmas in Case
-studies. Compiling these files for vos/vok target would raise errors.
-We provide adapted targets:
-
-## configure
-
-```
-coq_makefile -f _CoqProject -o Makefile
-```
-
-See below for faster compilation.
-
-## build (slow)
-
-```
-make
-```
-
-Be aware this may take more than 10mn to compile due to some case
-studies. You may want to comment them in the _CoqProject file before
-the configure step above if you are not interested in these case
-studies. Another solution is to follow the fast compilation recipes
-below.
-
-Doing this once a week when developing is good practice. This is the
-only way to make a really safe compilation including all
-xxx_Assumption.v. You should always do this once in a while to make
-sure some universe constraints aren't failing and to check if you did
-not miss any remaining axiom.
-
-But during the development process this makes the compilation when
-switching between files too slow. Hence the following less safe
-compilation processes:
-
-
-## build (slow, almost safe, but very parallelisable)
-
-```
-make [-j] vok
-```
-or better when developing
-```
-make [-j] vok-nocheck
-```
-Doing this once a day when developing is good practice.
-
-## build (Very fast, unsafe)
-
-```
-make [-j] vos
-```
-or better when developing
-```
-make [-j] vos-nocheck
-```
-
-This should be your prefered way of compiling when developing. It is
-much faster. It is unsafe but in most situations no bad surprise are
-to be expected.
-
-You should do real compilations from time to time as explained above.
-
-### proofgeneral
-
-For easy use of this feature (vos) you can use the auto compilation
-feature of proofgeneral. menu:
-
-menu: Coq / Auto Compilation / Compile Before Require
-and then: Coq / Auto Compilation / vos compilation
-
-Now you can transparently script in any buffer, all needed file will
-be compiled quickly. Don't forget to make a big fat "make" from time
-to time.
+- *CaseStudies/* : Case studies
+
+# Case Studies
+
+The directory `CaseStudies` contains the following the following case
+studies. Each case study (say `casestudy.v`) has a companion file
+called `casestudy_Assuptions.v` whose only purpose is to call `Print
+Assumption` on the main theorem of the case study. The reason why this
+command is not included in the case study itself is for allowing fast
+compilation of the case study.
+
+Here is a list of the current case studies:
+
+- [Convergence/](Casestudy/Convergence):
+ - [Algorithm_noB.v](CaseStudies/Convergence/Algorithm_noB.v):
+ Convergence without byzantine robots on the euclidean plane.
+
+ - [Impossibility_2G_1B.v](CaseStudies/Convergence/Impossibility_2G_1B.v):
+ Impossibility of convergence on the line when 1/3 of robots are
+ byzantine. Auger, Bouzid, Courtieu, Tixeuil, Urbain. Certified
+ Impossibility Results for Byzantine-Tolerant Mobile Robots. SSS
+ 2013.
+
+- [Gathering/](CaseStudies/Gathering): Gathering in R or R² for
+ various models
+ - [Impossibility.v](CaseStudies/Gathering/Impossibility.v):
+ Impossibility of gathering in SSYNC.
+ - [Definitions.v](CaseStudies/Gathering/Definitions.v): Common
+ definitions about the gathering problem.
+ - [WithMultiplicity.v](CaseStudies/Gathering/WithMultiplicity.v):
+ Common definition on gathering when robot enjoy strong
+ multiplicity detection.
+ - [InR/](CaseStudies/Gathering/InR) case studies for the gathering
+ on the enclidean line
+ - [Impossibility.v](CaseStudies/Gathering/InR/Impossibility.v):
+ Impossibility of gathering on the line in SSYNC.
+ - [Algorithm.v](CaseStudies/Gathering/InR/Algorithm.v): Gathering
+ one the line in SSYNC with strong multiplicity detection, from
+ non bivalent configurations.
+ - [InR2/](CaseStudies/Gathering/InR2) case studies for the gathering
+ on the enclidean plane
+ - [Peleg.v](CaseStudies/Gathering/InR2/Peleg.v):
+ Formalization of a protocol for gathering with lights due to Peleg.
+ - [Viglietta.v](CaseStudies/Gathering/InR2/Viglietta.v):
+ Formalization of a protocol for gathering with lights due to Viglietta.
+ - [FSyncFlexNoMultAlgorithm.v](CaseStudies/Gathering/InR2/FSyncFlexNoMultAlgorithm.v):
+ Gathering in FSYNC and non rigid moves with weak mutliplicity detection.
+ - [Algorithm.v](CaseStudies/Gathering/InR2/Algorithm.v):
+ Gathering in R2 in SSYNC with strong multiplicity detection, from
+ non bivalent configurations.
+- [Exploration/](CaseStudies/Exploration): Exploration of a ring with stop
+ - [ImpossibilityKDividesN.v](CaseStudies/Exploration/ImpossibilityKDividesN.v):
+ Impossibility of exploration of a ring when the number of robots
+ divides the number of nodes.
+ - [ExplorationDefs.v](CaseStudies/Exploration/ExplorationDefs.v):
+ Common definitions on exploration.
+ - [Tower.v](CaseStudies/Exploration/Tower.v):
+ ???
+- [LifeLine/](CaseStudies/LifeLine): Life line connection in the 2D Euclidean plane
+ - [Algorithm.v](CaseStudies/LifeLineAlgorithm.v):
+ Connection maintenance protocol on R2.
+
+# Other Related Ressources
+
+A general description of the Pactole library and its use:
+
+ Courtieu, L. Rieg, S. Tixeuil, and X. Urbain. Swarms of Mobile Robots: Towards
+ Versatility with Safety. Leibniz Transactions on Embedded Systems, 8(2):02:1–
+ 02:36, 2022.
diff --git a/Setting.v b/Setting.v
index 8146c286d2f025822b9c76887d15ea14a9cde81f..d2caa4e46a69a4208428606399ac42f72a09a2f1 100644
--- a/Setting.v
+++ b/Setting.v
@@ -1,8 +1,13 @@
Require Export SetoidDec.
Require Export Pactole.Util.Coqlib.
+Require Export Pactole.Util.SetoidDefs.
+Require Export Pactole.Util.NumberComplements.
+Require Export Pactole.Util.ListComplements.
Require Export Pactole.Util.Ratio.
Require Pactole.Util.Stream.
Require Pactole.Util.Lexprod.
+Require Pactole.Util.Fin.
+Require Pactole.Util.Enum.
Require Export Pactole.Core.Identifiers.
Require Export Pactole.Core.State.
Require Export Pactole.Core.Configuration.
@@ -14,26 +19,26 @@ Remove Hints eq_setoid : Setoid.
Coercion Bijection.section : Bijection.bijection >-> Funclass.
Coercion Similarity.sim_f : Similarity.similarity >-> Bijection.bijection.
-Existing Instance Stream.stream_Setoid.
-Existing Instance Stream.hd_compat.
-Existing Instance Stream.tl_compat.
-Existing Instance Stream.constant_compat.
-Existing Instance Stream.aternate_compat.
-Existing Instance Stream.instant_compat.
-Existing Instance Stream.forever_compat.
-Existing Instance Stream.eventually_compat.
-Existing Instance Stream.instant2_compat.
-Existing Instance Stream.forever2_compat.
-Existing Instance Stream.eventually2_compat.
-Existing Instance Stream.instant2_refl.
-Existing Instance Stream.instant2_sym.
-Existing Instance Stream.instant2_trans.
-Existing Instance Stream.forever2_refl.
-Existing Instance Stream.forever2_sym.
-Existing Instance Stream.forever2_trans.
-Existing Instance Stream.eventually2_refl.
-Existing Instance Stream.eventually2_sym.
-Existing Instance Stream.map_compat.
+Global Existing Instance Stream.stream_Setoid.
+Global Existing Instance Stream.hd_compat.
+Global Existing Instance Stream.tl_compat.
+Global Existing Instance Stream.constant_compat.
+Global Existing Instance Stream.aternate_compat.
+Global Existing Instance Stream.instant_compat.
+Global Existing Instance Stream.forever_compat.
+Global Existing Instance Stream.eventually_compat.
+Global Existing Instance Stream.instant2_compat.
+Global Existing Instance Stream.forever2_compat.
+Global Existing Instance Stream.eventually2_compat.
+Global Existing Instance Stream.instant2_refl.
+Global Existing Instance Stream.instant2_sym.
+Global Existing Instance Stream.instant2_trans.
+Global Existing Instance Stream.forever2_refl.
+Global Existing Instance Stream.forever2_sym.
+Global Existing Instance Stream.forever2_trans.
+Global Existing Instance Stream.eventually2_refl.
+Global Existing Instance Stream.eventually2_sym.
+Global Existing Instance Stream.map_compat.
(* By experience, this is not very useful
(** For simplicity, we gather into one definition all the classes that must be instanciated
@@ -67,4 +72,4 @@ Class GlobalDefinitions := {
glob_robot_choice glob_frame_choice glob_update_choice;
glob_inactive_function :> @inactive_function _ _ glob_State glob_Names _ glob_inactive_choice
}.
-*)
\ No newline at end of file
+*)
diff --git a/Spaces/EuclideanSpace.v b/Spaces/EuclideanSpace.v
index a1cb84fbabbea91b04c2ee5af67ba704fbee10b0..8ceadb0e0b1e52ded20f15d6f91a787dca62a3cb 100644
--- a/Spaces/EuclideanSpace.v
+++ b/Spaces/EuclideanSpace.v
@@ -28,8 +28,8 @@ Class EuclideanSpace (T : Type) {S : Setoid T} {EQ : @EqDec T S} {VS : RealVecto
inner_product_nonneg : forall u, 0 <= inner_product u u;
inner_product_defined : forall u, inner_product u u = 0%R <-> u == origin}.
-Existing Instance inner_product_compat.
-Arguments inner_product {T%type} {_} {_} {_} {_} u%VS V%VS.
+Global Existing Instance inner_product_compat.
+Arguments inner_product {T%_type} {_} {_} {_} {_} u%_VS V%_VS.
Notation "〈 u , v 〉" := (inner_product u v) (format "'〈' u , v '〉'"): VectorSpace_scope.
(* Open Scope VectorSpace_scope. *)
@@ -156,7 +156,7 @@ Section PerpendicularResults.
Qed.
End PerpendicularResults.
-Arguments perpendicular {T%type} {_} {_} {_} {_} u%VS v%VS.
+Arguments perpendicular {T%_type} {_} {_} {_} {_} u%_VS v%_VS.
Notation "u ⟂ v" := (perpendicular u v) (at level 50, no associativity).
(** *** The norm induced by the [inner_product] **)
diff --git a/Spaces/Graph.v b/Spaces/Graph.v
index f4b39d64bdede77fcc076d62e75b8ca793ac05a8..9ce11aa9a542f8dcc5dbd6043c801c013ebcedcc 100644
--- a/Spaces/Graph.v
+++ b/Spaces/Graph.v
@@ -8,43 +8,80 @@
*)
(**************************************************************************)
-
-Require Import Rbase SetoidDec.
+Require Import Utf8 Rbase SetoidDec.
Require Import Pactole.Util.Coqlib.
-Require Pactole.Core.Identifiers.
+Require Import Pactole.Util.Fin.
+Require Import Pactole.Util.Ratio.
+Require Import Pactole.Core.State.
Set Implicit Arguments.
Class Graph (V E : Type) := {
- V_Setoid :> Setoid V;
- E_Setoid :> Setoid E;
- V_EqDec :> EqDec V_Setoid;
- E_EqDec :> EqDec E_Setoid;
+ #[global] V_Setoid :: Setoid V;
+ #[global] E_Setoid :: Setoid E;
+ #[global] V_EqDec :: EqDec V_Setoid;
+ #[global] E_EqDec :: EqDec E_Setoid;
src : E -> V; (* source and target of an edge *)
tgt : E -> V;
- threshold : E -> R; (* TODO: use [strict_ratio] instead? *)
- threshold_pos : forall e, (0 < threshold e < 1)%R;
- src_compat :> Proper (equiv ==> equiv) src;
- tgt_compat :> Proper (equiv ==> equiv) tgt;
- threshold_compat :> Proper (equiv ==> Logic.eq) threshold;
+ #[global] src_compat :: Proper (equiv ==> equiv) src;
+ #[global] tgt_compat :: Proper (equiv ==> equiv) tgt;
find_edge : V -> V -> option E;
- find_edge_compat :> Proper (equiv ==> equiv ==> opt_eq equiv) find_edge;
- find_edge_None : forall a b : V, find_edge a b == None <-> forall e : E, ~(src e == a /\ tgt e == b);
- find_edge_Some : forall v1 v2 e, find_edge v1 v2 == Some e <-> v1 == src e /\ v2 == tgt e }.
+ #[global] find_edge_compat :: Proper (equiv ==> equiv ==> opt_eq equiv) find_edge;
+ find_edge_Some : ∀ e v1 v2, find_edge v1 v2 == Some e <-> v1 == src e /\ v2 == tgt e}.
-Global Opaque threshold_pos src_compat tgt_compat threshold_compat find_edge_compat find_edge_None find_edge_Some.
+Class ThresholdGraph (V E : Type) := {
+ nothreshold_graph : Graph V E;
+ threshold : E -> strict_ratio;
+ #[global] threshold_compat :: Proper (equiv ==> equiv) threshold}.
-(** A finite graph ia a graph where the set [V] of vertices is a prefix of N. *)
-(* FIXME: nothing prevents E from being infinite! *)
-(* TODO: Maybe we should reuse the type used for robot names *)
-Definition finite_node n := {m : nat | m < n}.
+Coercion nothreshold_graph : ThresholdGraph >-> Graph.
+Global Existing Instance nothreshold_graph.
+Global Opaque src_compat tgt_compat threshold_compat find_edge_compat find_edge_Some.
+
+Section some_lemmas.
+
+Context {V E : Type} {G : Graph V E}.
+
+Lemma find_edge_None : ∀ v1 v2 : V,
+ @find_edge _ _ G v1 v2 == None <-> ∀ e : E, ¬ (v1 == src e /\ v2 == tgt e).
+Proof using .
+ intros. rewrite <- (Decidable.not_not_iff _ (option_decidable _)).
+ setoid_rewrite not_None_iff. split.
+ - intros H1 e H2. apply H1. exists e. apply find_edge_Some, H2.
+ - intros H1 [e H2]. apply (H1 e), find_edge_Some, H2.
+Qed.
-(* We explictely define the setoid here to avoid using proj1_Setoid instead. *)
-Instance finite_node_Setoid n : Setoid (finite_node n) := eq_setoid _.
-Instance finite_node_EqDec n : EqDec (finite_node_Setoid n) := @Identifiers.subset_dec n.
+Lemma find_edge_pick : ∀ v1 v2 : V,
+ pick_spec (λ e : E, v1 == src e /\ v2 == tgt e) (find_edge v1 v2).
+Proof using .
+ intros. apply pick_Some_None. intros e.
+ apply find_edge_Some. apply find_edge_None.
+Qed.
-Definition FiniteGraph (n : nat) E := Graph (finite_node n) E.
+(* The specifications of find_edge make the graph simple *)
+Lemma simple_graph : ∀ e1 e2 : E,
+ @src _ _ G e1 == src e2 /\ @tgt _ _ G e1 == tgt e2 -> e1 == e2.
+Proof using .
+ intros * [Hs Ht]. apply Some_inj. erewrite <-2 (proj2 (find_edge_Some _ _ _)).
+ apply find_edge_compat. 3,4: split. 1,2,5,6: symmetry.
+ 1,3,5: apply Hs. all: apply Ht.
+Qed.
+
+Lemma simple_graph_iff : ∀ e1 e2 : E,
+ @src _ _ G e1 == src e2 /\ @tgt _ _ G e1 == tgt e2 <-> e1 == e2.
+Proof using .
+ intros. split. apply simple_graph. intros <-. split. all: reflexivity.
+Qed.
+
+End some_lemmas.
+
+(** A finite graph ia a graph where the set [V] of vertices is a prefix of N. *)
+(* FIXME: nothing prevents E from being infinite! *)
+(* Definition FiniteGraph (n : nat) E := Graph (fin n) E.
Existing Class FiniteGraph.
-Global Identity Coercion proj_graph : FiniteGraph >-> Graph.
+Global Identity Coercion proj_graph : FiniteGraph >-> Graph. *)
+
+Definition NodesLoc {V E : Type} {G : Graph V E} : Location
+ := make_Location V.
diff --git a/Spaces/Grid.v b/Spaces/Grid.v
index d973803b6fb15624dcf9f3f6692f23dd83126b0d..4b6c7aa433efc52500211ec6360f9dadb4055d10 100644
--- a/Spaces/Grid.v
+++ b/Spaces/Grid.v
@@ -11,7 +11,7 @@
Require Import Psatz SetoidDec ZArith Rbase.
Require Import Pactole.Util.Coqlib.
-(*Require Import Pactole.Core.Robots.*)
+Require Import Pactole.Util.Bijection.
Require Export Pactole.Spaces.Graph.
@@ -24,10 +24,10 @@ Open Scope Z_scope.
Inductive direction :=
North | South | East | West | Self.
-Instance direction_Setoid : Setoid direction := eq_setoid _.
+#[export] Instance direction_Setoid : Setoid direction := eq_setoid _.
-Instance direction_EqDec : EqDec direction_Setoid.
-Proof.
+#[export] Instance direction_EqDec : EqDec direction_Setoid.
+Proof using .
intros x y. simpl. change (x = y -> False) with (x <> y). decide equality.
Defined.
@@ -35,9 +35,9 @@ Defined.
Notation node := (Z*Z)%type.
Notation edge := (Z*Z*direction)%type.
-Instance node_Setoid : Setoid node := eq_setoid _.
-Instance node_EqDec : EqDec node_Setoid.
-Proof.
+#[export] Instance node_Setoid : Setoid node := eq_setoid _.
+#[export] Instance node_EqDec : EqDec node_Setoid.
+Proof using .
intros x y.
destruct (fst x =?= fst y).
+ destruct (snd x =?= snd y).
@@ -46,9 +46,9 @@ destruct (fst x =?= fst y).
+ right. abstract (destruct x, y; injection; auto).
Defined.
-Instance edge_Setoid : Setoid edge := eq_setoid _.
-Instance edge_EqDec : EqDec edge_Setoid.
-Proof.
+#[export] Instance edge_Setoid : Setoid edge := eq_setoid _.
+#[export] Instance edge_EqDec : EqDec edge_Setoid.
+Proof using .
intros x y.
destruct (fst x =?= fst y).
+ destruct (snd x =?= snd y).
@@ -68,39 +68,24 @@ Definition edge_tgt (e : edge) : node :=
Arguments edge_tgt !e.
(** The Z² grid is a graph. *)
-Instance Z2 : Graph node edge.
+#[export] Instance Z2 : Graph node edge.
simple refine {| V_EqDec := node_EqDec;
E_EqDec := edge_EqDec;
src := fst;
- tgt := edge_tgt;
- threshold := fun _ => (1 / 2)%R |}.
-Proof.
-* (* threshold_pos *)
- intros. lra.
+ tgt := edge_tgt; |}.
+Proof using .
* (* find_edge *)
exact (fun x y : node => if equiv_dec (EqDec := node_EqDec) y x then Some (x, Self) else
if y =?= (fst x + 1, snd x) then Some (x, East) else
if y =?= (fst x, snd x + 1) then Some (x, North) else
if y =?= (fst x - 1, snd x) then Some (x, West) else
if y =?= (fst x, snd x - 1) then Some (x, South) else None).
-* (* find_edge_None *)
- intros x y. cbn -[equiv]. repeat destruct_match.
- + abstract (split; try tauto; []; intro He; apply (He (x, Self)); auto).
- + abstract (split; try tauto; []; intro He; apply (He (x, East)); auto).
- + abstract (split; try tauto; []; intro He; apply (He (x, North)); auto).
- + abstract (split; try tauto; []; intro He; apply (He (x, West)); auto).
- + abstract (split; try tauto; []; intro He; apply (He (x, South)); auto).
- + split; intros _; auto; [].
- abstract (intros [x' d] [Hx He]; simpl in Hx; subst x';
- rewrite <- He in *; destruct d; unfold edge_tgt in *; simpl in *; auto).
* (* find_edge_Some *)
- intros x y e. cbn -[equiv]. repeat destruct_match; simpl;
- try abstract (solve [ split; intro Heq; subst; unfold edge_tgt; simpl in *; try tauto; [];
- destruct e as [p d], Heq as [? Heq]; simpl in *; f_equal; trivial; [];
- subst; unfold edge_tgt in *;
- destruct p, d; simpl in *; reflexivity || (injection Heq; lia) ]); [].
- split; try tauto; []. intros [].
- abstract (subst; destruct e as [? []]; unfold edge_tgt in *; simpl in *; auto).
+ abstract (intros [p d] x y; cbn-[equiv];
+ assert (forall x : Z, x <> x + 1) by lia;
+ assert (forall x : Z, x <> x - 1) by lia;
+ assert (forall x : Z, x + 1 <> x - 1) by lia;
+ repeat destruct_match; destruct x, y, p, d; cbn in *; intuition congruence).
Defined.
(** ** Change of frame of reference in Z² **)
@@ -109,14 +94,14 @@ Require Pactole.Util.Bijection.
Require Import Pactole.Core.State.
Require Import Pactole.Core.Formalism.
-Instance Loc : Location := {| location := node |}.
+#[export] Instance Loc : Location := {| location := node |}.
(** angle: anglei represents the possible angles for a rotation of reflection:
- for a rotation: angle i/2 * pi;
- for a reflection: angle i/4 * pi *)
Inductive angle := angle0 | angle1 | angle2 | angle3.
-Instance angle_Setoid : Setoid angle := eq_setoid _.
-Instance angle_EqDec : EqDec angle_Setoid.
-Proof.
+#[export] Instance angle_Setoid : Setoid angle := eq_setoid _.
+#[export] Instance angle_EqDec : EqDec angle_Setoid.
+Proof using .
intros x y. simpl.
change (x = y -> False) with (x <> y).
decide equality.
@@ -136,13 +121,13 @@ Definition opp_angle (r : angle) :=
Definition translation (v : Z*Z) : Bijection.bijection (Z*Z).
refine {| Bijection.section := fun x => (fst x + fst v, snd x + snd v);
Bijection.retraction := fun x => (fst x - fst v, snd x - snd v) |}.
-Proof.
+Proof using .
intros x y. simpl.
abstract (split; intro; subst; destruct x || destruct y; f_equal; simpl; lia).
Defined.
-Instance translation_compat : Proper (equiv ==> equiv) translation.
-Proof. intros ? ? Heq x. now rewrite Heq. Qed.
+#[export] Instance translation_compat : Proper (equiv ==> equiv) translation.
+Proof. intros ? ? Heq x. Fail timeout 2 now rewrite Heq. cbn in Heq. now subst. Qed.
(** Rotation *)
Definition mk_rotation r : Z*Z -> Z*Z :=
@@ -153,15 +138,19 @@ Definition mk_rotation r : Z*Z -> Z*Z :=
| angle3 => fun x => (snd x, - fst x)
end.
+Lemma mk_rotation_compat : forall r, Proper (equiv ==> equiv) (mk_rotation r).
+Proof. intros [] [] [] Heq; cbn; congruence. Qed.
+
Definition rotation (r : angle) : Bijection.bijection (Z*Z).
- refine {| Bijection.section := mk_rotation r;
- Bijection.retraction := mk_rotation (opp_angle r) |}.
-Proof.
-intros x y. simpl.
-abstract (split; intro; subst; destruct r; simpl; destruct x || destruct y; simpl; f_equal; lia).
+ refine {| Bijection.section := mk_rotation r;
+ Bijection.retraction := mk_rotation (opp_angle r);
+ Bijection.section_compat := mk_rotation_compat r |}.
+Proof using .
+intros x y. cbn.
+abstract (split; intro; subst; destruct r; cbn; destruct x || destruct y; cbn; f_equal; lia).
Defined.
-Instance rotation_compat : Proper (equiv ==> equiv) rotation := reflexive_proper _.
+(* #[export] Instance rotation_compat : Proper (equiv ==> equiv) rotation := reflexive_proper _. *)
(** Reflection *)
Definition mk_reflection r : Z*Z -> Z*Z :=
@@ -172,36 +161,40 @@ Definition mk_reflection r : Z*Z -> Z*Z :=
| angle3 => fun x => (- snd x, - fst x)
end.
+Lemma mk_reflection_compat : forall r, Proper (equiv ==> equiv) (mk_reflection r).
+Proof. intros [] [] [] Heq; cbn; congruence. Qed.
+
Definition reflection (r : angle) : Bijection.bijection (Z*Z).
refine {| Bijection.section := mk_reflection r;
- Bijection.retraction := mk_reflection r |}.
-Proof.
-intros x y. simpl.
-abstract (split; intro; subst; destruct r; simpl; destruct x || destruct y; simpl; f_equal; lia).
+ Bijection.retraction := mk_reflection r;
+ Bijection.section_compat := mk_reflection_compat r |}.
+Proof using .
+intros x y. cbn.
+abstract (split; intro; subst; destruct r; cbn; destruct x || destruct y; cbn; f_equal; lia).
Defined.
-Instance reflection_compat : Proper (equiv ==> equiv) reflection := reflexive_proper _.
+(* #[export] Instance reflection_compat : Proper (equiv ==> equiv) reflection := reflexive_proper _. *)
(** *** Change of frame of reference **)
(** Translation **)
-Instance FCTranslation : frame_choice (Z*Z) := {|
+#[export] Instance FCTranslation : frame_choice (Z*Z) := {|
frame_choice_bijection := translation;
frame_choice_Setoid := _;
frame_choice_bijection_compat := _ |}.
(** Rigid Motion **)
-Instance rigid_motion_compat :
+#[export] Instance rigid_motion_compat :
Proper (equiv ==> equiv) (fun rm => rotation (snd rm) ∘ translation (fst rm)).
-Proof. intros ? ? [Hv Ha]; do 2 f_equiv; assumption. Qed.
+Proof using . intros ? ? [Hv Ha]; do 2 f_equiv; assumption. Qed.
-Instance FCRigidMotion : frame_choice (Z*Z*angle) := {|
+#[export] Instance FCRigidMotion : frame_choice (Z*Z*angle) := {|
frame_choice_bijection := fun rm => rotation (snd rm) ∘ translation (fst rm);
frame_choice_Setoid := prod_Setoid node_Setoid angle_Setoid;
frame_choice_bijection_compat := rigid_motion_compat |}.
(** Similarities *)
-Instance FCSimilarity : frame_choice (bool*(Z*Z)*angle)%type.
+#[export] Instance FCSimilarity : frame_choice (bool*(Z*Z)*angle)%type.
simple refine {|
frame_choice_bijection := fun '(b, v, a) =>
rotation a ∘ translation v ∘ (if b : bool then reflection angle0 else @Bijection.id node _);
diff --git a/Spaces/Isometry.v b/Spaces/Isometry.v
index 608b3aa2d66bb5d5f3841523548c47e7da75054f..50f02376ee51c00a64bcd5fdf2432bf174c5c12c 100644
--- a/Spaces/Isometry.v
+++ b/Spaces/Isometry.v
@@ -47,7 +47,7 @@ Record isometry := {
Global Instance isometry_Setoid : Setoid isometry.
simple refine {| equiv := fun sim1 sim2 => equiv (iso_f sim1) (iso_f sim2) |}.
-Proof.
+Proof using .
* apply bij_Setoid.
* split.
+ repeat intro. reflexivity.
@@ -73,11 +73,11 @@ Definition id : isometry := {|
(** Composition of isometries *)
Definition comp (f g : isometry) : isometry.
refine {| iso_f := @compose (Bijection.bijection T) _ _ f g |}.
-Proof. abstract (intros; simpl; now rewrite f.(dist_prop), g.(dist_prop)). Defined.
+Proof using . abstract (intros; simpl; now rewrite f.(dist_prop), g.(dist_prop)). Defined.
Global Instance IsometryComposition : Composition isometry.
refine {| compose := comp |}.
-Proof. intros f1 f2 Hf g1 g2 Hg x. cbn. now rewrite Hf, Hg. Defined.
+Proof using . intros f1 f2 Hf g1 g2 Hg x. cbn. now rewrite Hf, Hg. Defined.
Lemma compose_assoc : forall f g h, f ∘ (g ∘ h) == (f ∘ g) ∘ h.
Proof using . repeat intro. reflexivity. Qed.
@@ -91,14 +91,14 @@ Proof using . intros sim x. simpl. reflexivity. Qed.
(** Inverse of an isometry *)
Definition inv (iso : isometry) : isometry.
refine {| iso_f := inverse iso.(iso_f) |}.
-Proof.
+Proof using .
intros x y.
rewrite <- iso.(dist_prop). simpl. now repeat rewrite section_retraction.
Defined.
Global Instance IsometryInverse : Inverse isometry.
refine {| inverse := inv |}.
-Proof. intros f g Hfg x. simpl. now f_equiv. Defined.
+Proof using . intros f g Hfg x. simpl. now f_equiv. Defined.
Lemma compose_inverse_l : forall iso : isometry, (iso â»Â¹ ∘ iso) == id.
Proof using . intros iso x. simpl. now rewrite retraction_section; autoclass. Qed.
@@ -179,7 +179,7 @@ Definition bij_translation (v : T) : @bijection T _.
refine {|
section := fun x => add x v;
retraction := fun x => add x (opp v) |}.
-Proof.
+Proof using VS.
+ now repeat intro; apply add_compat.
+ apply bij_translation_Inversion.
Defined.
@@ -189,7 +189,7 @@ Proof using . intros. ring_simplify. apply dist_translation. Qed.
Definition translation (v : T) : isometry T.
refine {| iso_f := bij_translation v |}.
-Proof. cbn -[dist]. abstract (now intros; rewrite dist_translation). Defined.
+Proof using . cbn -[dist]. abstract (now intros; rewrite dist_translation). Defined.
Global Instance translation_compat : Proper (equiv ==> equiv) translation.
Proof using . intros u v Huv x. simpl. now rewrite Huv. Qed.
@@ -201,3 +201,4 @@ Lemma translation_inverse : forall t, inverse (translation t) == translation (op
Proof using . intros t x. simpl. reflexivity. Qed.
End Translation.
+
diff --git a/Spaces/Isomorphism.v b/Spaces/Isomorphism.v
index c76a707bc0ed940dfea5f984a9fe6c7a531347de..b4133a6e68f32cc043d6625f3ac74d0e7953dde9 100644
--- a/Spaces/Isomorphism.v
+++ b/Spaces/Isomorphism.v
@@ -32,22 +32,18 @@ Context {G : Graph V E}.
Record isomorphism := {
iso_V :> bijection V;
iso_E : bijection E;
- iso_T : bijection R;
- iso_morphism : forall e, iso_V (src e) == src (iso_E e)
- /\ iso_V (tgt e) == tgt (iso_E e);
- iso_threshold : forall e, iso_T (threshold e) = threshold (iso_E e);
- iso_incr : forall a b, (a < b)%R -> (iso_T a < iso_T b)%R;
- iso_bound_T : forall r, (0 < iso_T r < 1)%R <-> (0 < r < 1)%R }.
+ iso_morphism : ∀ e, iso_V (src e) == src (iso_E e)
+ /\ iso_V (tgt e) == tgt (iso_E e) }.
Global Instance isomorphism_Setoid : Setoid isomorphism.
-simple refine {| equiv := fun iso1 iso2 => iso1.(iso_V) == iso2.(iso_V)
- /\ iso1.(iso_E) == iso2.(iso_E)
- /\ iso1.(iso_T) == iso2.(iso_T) |}; autoclass.
-Proof. split.
-+ intro f. now repeat split.
-+ intros f g Hfg; destruct Hfg as [HV [HE HT]]. repeat split; intro; now symmetry.
-+ intros f g h Hfg Hgh. destruct Hfg as [? [? ?]], Hgh as [? [? ?]].
- repeat split; intro; etransitivity; eauto.
+Proof using .
+ simple refine {|
+ equiv := λ iso1 iso2, iso1.(iso_V) == iso2.(iso_V)
+ /\ iso1.(iso_E) == iso2.(iso_E) |}; autoclass. split.
+ + intro f. now repeat split.
+ + intros f g Hfg; destruct Hfg as [HV HE]. split; now symmetry.
+ + intros f g h Hfg Hgh. destruct Hfg as [? ?], Hgh as [? ?].
+ split; etransitivity; eauto.
Defined.
Instance iso_V_compat : Proper (equiv ==> equiv) iso_V.
@@ -56,33 +52,26 @@ Proof using . intros ? ? Heq ?. now apply Heq. Qed.
Instance iso_E_compat : Proper (equiv ==> equiv) iso_E.
Proof using . intros ? ? Heq ?. now apply Heq. Qed.
-Instance iso_T_compat : Proper (equiv ==> equiv) iso_T.
-Proof using . intros ? ? Heq ?. now apply Heq. Qed.
-
+Lemma equiv_iso_V_to_iso_E iso1 iso2:
+ iso_V iso1 == iso_V iso2 -> iso_E iso1 == iso_E iso2.
+Proof using .
+ intros Heqiso_V e. apply simple_graph. rewrite <-! (proj1 (iso_morphism _ _)),
+ <-! (proj2 (iso_morphism _ _)), <- Heqiso_V. split. all: reflexivity.
+Qed.
Definition id : isomorphism.
-refine {| iso_V := @id V _;
- iso_E := @id E _;
- iso_T := @id R _ |}.
-Proof.
-+ now intros.
-+ now intros.
-+ now intros.
-+ now intros.
+Proof using .
+ refine {| iso_V := id;
+ iso_E := id |}.
+ now intros.
Defined.
-
Definition comp (f g : isomorphism) : isomorphism.
-refine {|
- iso_V := compose f.(iso_V) g.(iso_V);
- iso_E := compose f.(iso_E) g.(iso_E);
- iso_T := compose f.(iso_T) g.(iso_T) |}.
-Proof.
-+ intro. simpl.
- split; now rewrite <- 2 (proj1 (iso_morphism _ _)) || rewrite <- 2 (proj2 (iso_morphism _ _)).
-+ intro. simpl. now rewrite 2 iso_threshold.
-+ intros. simpl. now do 2 apply iso_incr.
-+ intro. simpl. now rewrite 2 iso_bound_T.
+Proof using .
+ refine {|
+ iso_V := compose f.(iso_V) g.(iso_V);
+ iso_E := compose f.(iso_E) g.(iso_E) |}.
+ intro. simpl. split; now rewrite <- 2 (proj1 (iso_morphism _ _)) || rewrite <- 2 (proj2 (iso_morphism _ _)).
Defined.
Global Instance IsoComposition : Composition isomorphism.
@@ -92,72 +81,63 @@ Proof. intros f1 f2 Hf g1 g2 Hg. repeat split; intro; simpl; now rewrite Hf, Hg.
(* Global Instance compose_compat : Proper (equiv ==> equiv ==> equiv) compose.
Proof. intros f1 f2 Hf g1 g2 Hg. repeat split; intro; simpl; now rewrite Hf, Hg. Qed. *)
-Lemma compose_assoc : forall f g h, f ∘ (g ∘ h) == (f ∘ g) ∘ h.
-Proof using . intros f g h; repeat split; simpl; reflexivity. Qed.
+Lemma compvE : ∀ iso1 iso2 : isomorphism,
+ iso_V (iso1 ∘ iso2) = iso_V iso1 ∘ iso_V iso2 :> bijection V.
+Proof using . reflexivity. Qed.
+
+Lemma compeE : ∀ iso1 iso2 : isomorphism,
+ iso_E (iso1 ∘ iso2) = iso_E iso1 ∘ iso_E iso2 :> bijection E.
+Proof using . reflexivity. Qed.
-Set Printing Implicit.
+Lemma compose_assoc : ∀ f g h, f ∘ (g ∘ h) == (f ∘ g) ∘ h.
+Proof using . intros f g h; repeat split; simpl; reflexivity. Qed.
Definition inv (iso : isomorphism) : isomorphism.
+Proof using .
refine {| iso_V := inverse iso.(iso_V);
- iso_E := inverse iso.(iso_E);
- iso_T := inverse iso.(iso_T)
- |}.
-Proof.
-+ intro. simpl. rewrite <- 2 Inversion, (proj1 (iso_morphism _ _)), (proj2 (iso_morphism _ _)).
+ iso_E := inverse iso.(iso_E) |}.
+ intro. simpl. rewrite <- 2 Inversion, (proj1 (iso_morphism _ _)), (proj2 (iso_morphism _ _)).
split; apply src_compat || apply tgt_compat; now rewrite Inversion.
-+ intro. simpl. change eq with (@equiv R _). rewrite <- Inversion, iso_threshold.
- apply threshold_compat. now rewrite Inversion.
-+ intros a b Hab.
- simpl.
- assert (Hincr := iso_incr iso).
- assert (forall x y, @retraction R _ (iso_T iso) x < @retraction R _ (iso_T iso) y -> x < y)%R.
- { intros.
- specialize (Hincr (@retraction R _ (iso_T iso) x) (@retraction R _ (iso_T iso) y) H).
- now do 2 rewrite section_retraction in Hincr. }
- assert (Hnondecr:
- (forall x y, x <= y -> @retraction R _ (iso_T iso) x <= @retraction R _ (iso_T iso) y)%R).
- { intros x y Hle. apply Rnot_lt_le. apply Rle_not_lt in Hle. intuition. }
- destruct (Hnondecr a b) as [| Heq]; auto; intuition; [].
- apply (f_equal (iso_T iso)) in Heq. rewrite 2 section_retraction in Heq. lra.
-+ intro. simpl.
- assert (Hbound := iso_bound_T iso). specialize (Hbound (@retraction R _ (iso_T iso) r)).
- now rewrite section_retraction in Hbound.
Defined.
Global Instance IsoInverse : Inverse isomorphism.
-refine {| inverse := inv |}.
-Proof.
-intros f g [? [? ?]].
-repeat split; intro; simpl; change eq with (@equiv R _); f_equiv; auto.
+Proof using .
+ refine {| inverse := inv |}.
+ intros f g [? ?]. repeat split; intro; simpl; change eq with (@equiv R _); f_equiv; auto.
Defined.
+Lemma id_inv : idâ»Â¹ == id.
+Proof using . split. all: setoid_rewrite id_inv. all: reflexivity. Qed.
+
+Lemma id_comp_l : ∀ iso : isomorphism, id ∘ iso == iso.
+Proof using. intros. split. all: setoid_rewrite id_comp_l. all: reflexivity. Qed.
+
+Lemma id_comp_r : ∀ iso : isomorphism, iso ∘ id == iso.
+Proof using. intros. split. all: setoid_rewrite id_comp_r. all: reflexivity. Qed.
+
+Lemma inv_inv : ∀ iso : isomorphism, isoâ»Â¹â»Â¹ == iso.
+Proof using . intros. split. all: setoid_rewrite inv_inv. all: reflexivity. Qed.
+
(* Global Instance inverse_compat : Proper (equiv ==> equiv) inverse.
Proof.
intros f g [? [? ?]].
repeat split; intro; simpl; change eq with (@equiv R _); f_equiv; auto.
Qed. *)
-Lemma compose_inverse_l : forall iso : isomorphism, iso â»Â¹ ∘ iso == id.
+Lemma compose_inverse_l : ∀ iso : isomorphism, iso â»Â¹ ∘ iso == id.
Proof using . intro. repeat split; intro; simpl; try now rewrite retraction_section; autoclass. Qed.
-Lemma compose_inverse_r : forall iso : isomorphism, iso ∘ (iso â»Â¹) == id.
+Lemma compose_inverse_r : ∀ iso : isomorphism, iso ∘ (iso â»Â¹) == id.
Proof using . intro. repeat split; intro; simpl; try now rewrite section_retraction; autoclass. Qed.
-Lemma inverse_compose : forall f g : isomorphism, (f ∘ g) â»Â¹ == (g â»Â¹) ∘ (f â»Â¹).
+Lemma inverse_compose : ∀ f g : isomorphism, (f ∘ g) â»Â¹ == (g â»Â¹) ∘ (f â»Â¹).
Proof using . intros f g; repeat split; intro; simpl; reflexivity. Qed.
-Lemma injective : forall iso : isomorphism, Preliminary.injective equiv equiv iso.
-Proof using .
-intros f x y Heq. transitivity (id x); try reflexivity; [].
-rewrite <- (compose_inverse_l f). simpl. rewrite Heq.
-now apply compose_inverse_l.
-Qed.
-
End Isomorphism.
Arguments isomorphism {V} {E} G.
-Lemma find_edge_iso_Some `{G : Graph} : forall (iso : isomorphism G) src tgt e,
+Lemma find_edge_iso_Some `{G : Graph} : ∀ (iso : isomorphism G) src tgt e,
@find_edge _ _ G (iso src) (iso tgt) == Some (iso.(iso_E) e)
<-> @find_edge _ _ G src tgt == Some e.
Proof using .
@@ -174,7 +154,7 @@ revert iso src tgt e. apply strong_and.
simpl in Hstep. now rewrite 3 Bijection.retraction_section in Hstep.
Qed.
-Lemma find_edge_iso_None `{G : Graph} : forall (iso : isomorphism G) src tgt,
+Lemma find_edge_iso_None `{G : Graph} : ∀ (iso : isomorphism G) src tgt,
@find_edge _ _ G (iso src) (iso tgt) == None <-> @find_edge _ _ G src tgt == None.
Proof using .
intros iso src tgt. destruct (find_edge src tgt) eqn:Hcase.
diff --git a/Spaces/R.v b/Spaces/R.v
index f1e51f79c1e98b217b457c75b08a720f4190a40a..6a9803b480a6d37e6644f62c5ec9c533c2139de1 100644
--- a/Spaces/R.v
+++ b/Spaces/R.v
@@ -20,12 +20,11 @@
Require Import Bool.
-Require Import Arith.Div2.
Require Import Lia.
Require Export Rbase Rbasic_fun.
Require Import Sorting.
Require Import List.
-Require Import Relations.
+Require Import Relations RelationClasses.
Require Import RelationPairs.
Require Import SetoidDec.
Require Import Pactole.Util.Coqlib.
@@ -37,6 +36,8 @@ Import Permutation.
Set Implicit Arguments.
Open Scope R_scope.
+(* this will become non default soon. *)
+Ltac Tauto.intuition_solver ::= auto with *.
Typeclasses eauto := (bfs).
@@ -62,7 +63,7 @@ Proof.
* intro. nra.
* intro u. split; intro Heq.
+ apply Rmult_integral in Heq. now destruct Heq.
- + now rewrite Heq, Rmult_0_l.
+ + cbn in Heq. subst. apply Rmult_0_l.
Defined.
Lemma norm_R : forall x, norm x = Rabs x.
@@ -77,29 +78,29 @@ Ltac Rdec := repeat
match goal with
| |- context[@equiv_dec _ _ R_EqDec ?x ?x] =>
let Heq := fresh "Heq" in destruct (@equiv_dec _ _ R_EqDec x x) as [Heq | Heq];
- [clear Heq | exfalso; elim Heq; reflexivity]
+ [clear Heq | exfalso; contradiction Heq; reflexivity]
| |- context[@equiv_dec _ _ R_EqDec 1 0] =>
let Heq := fresh "Heq" in destruct (@equiv_dec _ _ R_EqDec 1 0) as [Heq | Heq];
- [now elim R1_neq_R0 | clear Heq]
+ [now contradiction R1_neq_R0 | clear Heq]
| |- context[@equiv_dec _ _ R_EqDec 0 1] =>
let Heq := fresh "Heq" in destruct (@equiv_dec _ _ R_EqDec 0 1) as [Heq | Heq];
- [now symmetry in Heq; elim R1_neq_R0 | clear Heq]
+ [now symmetry in Heq; contradiction R1_neq_R0 | clear Heq]
| H : context[@equiv_dec _ _ R_EqDec ?x ?x] |- _ =>
let Heq := fresh "Heq" in destruct (@equiv_dec _ _ R_EqDec x x) as [Heq | Heq];
- [clear Heq | exfalso; elim Heq; reflexivity]
+ [clear Heq | exfalso; contradiction Heq; reflexivity]
| |- context[Rdec ?x ?x] =>
let Heq := fresh "Heq" in destruct (Rdec x x) as [Heq | Heq];
- [clear Heq | exfalso; elim Heq; reflexivity]
+ [clear Heq | exfalso; contradiction Heq; reflexivity]
| |- context[Rdec 1 0] =>
let Heq := fresh "Heq" in destruct (Rdec 1 0) as [Heq | Heq];
- [now elim R1_neq_R0 | clear Heq]
+ [now contradiction R1_neq_R0 | clear Heq]
| |- context[Rdec 0 1] =>
let Heq := fresh "Heq" in destruct (Rdec 0 1) as [Heq | Heq];
- [now symmetry in Heq; elim R1_neq_R0 | clear Heq]
+ [now symmetry in Heq; contradiction R1_neq_R0 | clear Heq]
| H : context[Rdec ?x ?x] |- _ =>
let Heq := fresh "Heq" in destruct (Rdec x x) as [Heq | Heq];
- [clear Heq | exfalso; elim Heq; reflexivity]
- | H : ?x <> ?x |- _ => elim H; reflexivity
+ [clear Heq | exfalso; contradiction Heq; reflexivity]
+ | H : ?x <> ?x |- _ => contradiction H; reflexivity
end.
Ltac Rdec_full :=
@@ -115,7 +116,7 @@ Ltac Rdec_full :=
Ltac Rabs :=
match goal with
- | Hx : ?x <> ?x |- _ => now elim Hx
+ | Hx : ?x <> ?x |- _ => now contradiction Hx
| Heq : ?x == ?y, Hneq : ?y =/= ?x |- _ => symmetry in Heq; contradiction
| Heq : ?x == ?y, Hneq : ?y <> ?x |- _ => symmetry in Heq; contradiction
| Heq : ?x = ?y, Hneq : ?y =/= ?x |- _ => symmetry in Heq; contradiction
@@ -132,7 +133,7 @@ Ltac Rle_dec :=
end.
Global Instance Leibniz_fun_compat : forall f : R -> R, Proper (equiv ==> equiv) f.
-Proof. intros f ? ? Heq. now rewrite Heq. Qed.
+Proof. intros f ? ? Heq. cbn in *. now rewrite Heq. Qed.
(** A location is determined by distances to 2 points. *)
Lemma dist_case : forall x y, dist x y = x - y \/ dist x y = y - x.
@@ -165,14 +166,14 @@ Definition Rleb (x y : R) := if Rle_lt_dec x y then true else false.
Lemma Rleb_spec : forall x y, Rleb x y = true <-> Rle x y.
Proof.
intros x y; unfold Rleb; destruct (Rle_lt_dec x y); split; intro H; trivial.
-inversion H. elim (Rlt_not_le _ _ r H).
+inversion H. contradiction (Rlt_not_le _ _ r H).
Qed.
Corollary Rleb_total : forall x y, Rleb x y = true \/ Rleb y x = true.
Proof.
intros x y. unfold Rleb. destruct (Rle_lt_dec x y).
now left.
- right. destruct (Rle_lt_dec y x). reflexivity. elim (Rlt_irrefl x). now apply Rlt_trans with y.
+ right. destruct (Rle_lt_dec y x). reflexivity. contradiction (Rlt_irrefl x). now apply Rlt_trans with y.
Qed.
Corollary Rleb_trans : Transitive Rleb.
@@ -209,7 +210,7 @@ apply (StronglySorted_ind (fun l => forall l', StronglySorted Rleb l' -> Permuta
now apply Permutation_cons_inv with b.
Qed.
-Instance sort_uniq : Proper (@Permutation R ==> eq) sort.
+Global Instance sort_uniq : Proper (@Permutation R ==> eq) sort.
Proof.
intros l l' Hl. apply StronglySorted_uniq.
- apply StronglySorted_sort. exact Rleb_trans.
@@ -217,7 +218,7 @@ intros l l' Hl. apply StronglySorted_uniq.
- transitivity l. symmetry. apply Permuted_sort. transitivity l'. assumption. apply Permuted_sort.
Qed.
-Instance sort_uniqA : Proper (PermutationA eq ==> eq) sort.
+Global Instance sort_uniqA : Proper (PermutationA eq ==> eq) sort.
Proof. intros ? ?. rewrite PermutationA_Leibniz. apply sort_uniq. Qed.
Corollary StronglySorted_sort_identity : forall l, StronglySorted Rleb l -> sort l = l.
@@ -406,10 +407,13 @@ Hint Immediate injective sim_Minjective : core.
Corollary similarity_monotonic : forall sim : similarity R, monotonic Rleb Rleb sim.
Proof.
intro sim. destruct (similarity_in_R_case sim) as [Hinc | Hdec].
-+ left. intros x y Hxy. do 2 rewrite Hinc. apply similarity_increasing; trivial.
- pose (Hratio := zoom_pos sim). lra.
-+ right. intros x y Hxy. do 2 rewrite Hdec. apply similarity_decreasing; trivial.
- assert (Hratio := zoom_pos sim). lra.
++ left. intros x y Hxy. cbn in Hinc. do 2 rewrite Hinc.
+ apply similarity_increasing; trivial; []. apply Rlt_le, zoom_pos.
++ right. intros x y Hxy. cbn in Hdec. do 2 rewrite Hdec.
+ apply similarity_decreasing; trivial; [].
+ (* TODO Coq 8.17 : does [lra] work again? *)
+ rewrite <- (Rplus_opp_r (zoom sim)), <- Rminus_0_l.
+ unfold Rminus. apply Rplus_le_compat; try lra; []. apply Rlt_le, zoom_pos.
Qed.
(** To conclude that two similarities are equal, it is enough to show that they are equal on two points. *)
@@ -424,8 +428,12 @@ assert (Hzoom : zoom sim1 = zoom sim2).
apply Rmult_eq_reg_r with (dist pt1 pt2); trivial; [].
now rewrite <- 2 dist_prop, H1, H2. }
assert (Hk : k1 = k2 \/ k1 = - k2).
-{ destruct Hk1, Hk2; subst; rewrite Hzoom, ?Ropp_involutive; tauto. }
-assert (k2 <> 0). { generalize (zoom_pos sim2). lra. }
+{ destruct Hk1, Hk2; subst; rewrite ?Ropp_involutive; intuition. }
+(* assert (k2 <> 0). { generalize (zoom_pos sim2). lra. } *)
+assert (k2 <> 0).
+{ destruct Hk2; subst k2.
+ - symmetry. apply Rlt_not_eq, zoom_pos.
+ - apply Rlt_not_eq, Ropp_lt_gt_0_contravar, Rlt_gt, zoom_pos. }
rewrite Hsim1, Hsim2 in *.
destruct Hk; subst k1.
+ (* Having same factor, they also have same center *)
@@ -448,30 +456,28 @@ simple refine {| sim_f := {| section := fun x => pt3 + (pt4 - pt3) / (pt2 - pt1)
Proof.
* abstract (intros; simpl in *; split; intro; subst; field; lra).
* intros x y. cbn -[dist]. repeat rewrite dist_R. unfold Rdiv.
- rewrite <- Rabs_Rinv.
- + repeat rewrite <- Rabs_mult. f_equal. ring.
- + simpl in *. lra.
+ rewrite <- Rabs_inv. repeat rewrite <- Rabs_mult. f_equal. ring.
Defined.
Lemma build_similarity_compat : forall pt1 pt1' pt2 pt2' pt3 pt3' pt4 pt4'
(H12 : pt1 =/= pt2) (H34 : pt3 =/= pt4) (H12' : pt1' =/= pt2') (H34' : pt3' =/= pt4'),
pt1 == pt1' -> pt2 == pt2' -> pt3 == pt3' -> pt4 == pt4' ->
build_similarity H12 H34 == build_similarity H12' H34'.
-Proof. intros * Heq1 Heq2 Heq3 Heq4 x. simpl. now rewrite Heq1, Heq2, Heq3, Heq4 in *. Qed.
+Proof. intros * Heq1 Heq2 Heq3 Heq4 x. cbn in *. now rewrite Heq1, Heq2, Heq3, Heq4 in *. Qed.
Lemma build_similarity_swap : forall pt1 pt2 pt3 pt4 (Hdiff12 : pt1 =/= pt2) (Hdiff34 : pt3 =/= pt4),
build_similarity (symmetry Hdiff12) (symmetry Hdiff34) == build_similarity Hdiff12 Hdiff34.
-Proof. repeat intro. simpl in *. field. lra. Qed.
+Proof. repeat intro. cbn in *. field. lra. Qed.
Lemma build_similarity_eq1 : forall pt1 pt2 pt3 pt4 (Hdiff12 : pt1 =/= pt2) (Hdiff34 : pt3 =/= pt4),
build_similarity Hdiff12 Hdiff34 pt1 == pt3.
-Proof. intros. simpl in *. field. lra. Qed.
+Proof. intros. cbn in *. field. lra. Qed.
(* This is wrong without the proper orientation *)
Lemma build_similarity_eq2 : forall pt1 pt2 pt3 pt4 (Hdiff12 : pt1 =/= pt2) (Hdiff34 : pt3 =/= pt4),
build_similarity Hdiff12 Hdiff34 pt2 == pt4.
-Proof. intros. simpl in *. field. lra. Qed.
+Proof. intros. cbn in *. field. lra. Qed.
Lemma build_similarity_inverse : forall pt1 pt2 pt3 pt4 (Hdiff12 : pt1 =/= pt2) (Hdiff34 : pt3 =/= pt4),
(build_similarity Hdiff12 Hdiff34)â»Â¹ == build_similarity Hdiff34 Hdiff12.
-Proof. repeat intro. simpl in *. field. lra. Qed.
+Proof. repeat intro. cbn in *. field. lra. Qed.
diff --git a/Spaces/R2.v b/Spaces/R2.v
index 72da872181ffb48bed49b9f02f199ffe4214e63e..44ec3a41fe08bee00075e221847c927600c263ee 100644
--- a/Spaces/R2.v
+++ b/Spaces/R2.v
@@ -26,18 +26,19 @@ Import List Permutation SetoidList.
Require Import SetoidDec.
Require Import FunInd.
Require Import Pactole.Util.Coqlib.
+Require Import Pactole.Util.Bijection.
Require Export Pactole.Spaces.EuclideanSpace.
Require Import Pactole.Spaces.Similarity.
Set Implicit Arguments.
Open Scope R_scope.
-Coercion Bijection.section : Bijection.bijection >-> Funclass.
+(* Coercion Bijection.section : Bijection.bijection >-> Funclass. *)
Import ListNotations.
(** ** R² as a Euclidean space over R **)
Definition R2 := (R * R)%type.
-Instance R2_Setoid : Setoid R2 := {| equiv := @Logic.eq R2 |}.
-Instance R2_EqDec : @EqDec R2 _.
+Global Instance R2_Setoid : Setoid R2 := {| equiv := @Logic.eq R2 |}.
+Global Instance R2_EqDec : @EqDec R2 _.
Proof.
intros x y.
destruct (Rdec (fst x) (fst y)).
@@ -125,12 +126,12 @@ Ltac R2dec := repeat
match goal with
| |- context[@equiv_dec _ _ R2_EqDec ?x ?x] =>
let Heq := fresh "Heq" in destruct (@equiv_dec _ _ R2_EqDec x x) as [Heq | Heq];
- [clear Heq | exfalso; elim Heq; reflexivity]
+ [clear Heq | exfalso; contradiction Heq; reflexivity]
| H : context[Rdec ?x ?x] |- _ =>
let Heq := fresh "Heq" in destruct (Rdec x x) as [Heq | Heq];
- [clear Heq | exfalso; elim Heq; reflexivity]
- | H : ?x <> ?x |- _ => elim H; reflexivity
- | H : ?x =/= ?x |- _ => elim H; reflexivity
+ [clear Heq | exfalso; contradiction Heq; reflexivity]
+ | H : ?x <> ?x |- _ => contradiction H; reflexivity
+ | H : ?x =/= ?x |- _ => contradiction H; reflexivity
| Heq : ?x == ?y, Hneq : ~?y == ?x |- _ => symmetry in Heq; contradiction
| Heq : ?x == ?y, Hneq : ~?x == ?y |- _ => contradiction
| Heq : ?x == ?y |- context[@equiv_dec _ _ R2_EqDec ?x ?y] =>
@@ -182,7 +183,7 @@ Lemma R2dec_bool_false_iff (x y : R2) : R2dec_bool x y = false <-> x =/= y.
Proof using .
unfold R2dec_bool.
destruct (equiv_dec x y); split; discriminate || auto.
-intros abs. rewrite e in abs. now elim abs.
+intros abs. rewrite e in abs. now contradiction abs.
Qed.
Lemma R2dec_bool_refl x: R2dec_bool x x = true.
@@ -198,10 +199,10 @@ Definition orthogonal (u : R2) : R2 := (/(norm u) * (snd u, (- fst u)%R))%VS.
Definition colinear (u v : R2) := perpendicular u (orthogonal v).
(* Compatibilities *)
-Instance orthogonal_compat : Proper (equiv ==> equiv) orthogonal.
+Global Instance orthogonal_compat : Proper (equiv ==> equiv) orthogonal.
Proof using . intros u v Heq. now rewrite Heq. Qed.
-Instance colinear_compat : Proper (equiv ==> equiv ==> iff) colinear.
+Global Instance colinear_compat : Proper (equiv ==> equiv ==> iff) colinear.
Proof using . intros u1 u2 Hu v1 v2 Hv. now rewrite Hu, Hv. Qed.
(** *** Results about [norm] **)
@@ -359,10 +360,10 @@ Qed.
Lemma colinear_dec : forall u v, {colinear u v} + {~colinear u v}.
Proof. intros u v. unfold colinear. apply perpendicular_dec. Defined.
-Instance colinear_Reflexive : Reflexive colinear.
+Global Instance colinear_Reflexive : Reflexive colinear.
Proof using . intro. apply orthogonal_perpendicular. Qed.
-Instance colinear_Symmetric : Symmetric colinear.
+Global Instance colinear_Symmetric : Symmetric colinear.
Proof using . intros u v H. unfold colinear. now rewrite perpendicular_sym, perpendicular_orthogonal_shift. Qed.
Lemma colinear_trans : forall u v w, ~equiv v origin -> colinear u v -> colinear v w -> colinear u w.
@@ -435,8 +436,7 @@ intros [x1 y1] Hnull [x2 y2]. unfold unitary, orthogonal, norm, inner_product. s
replace (Rpow_def.pow y1 2) with y1² by (unfold Rsqr; ring).
replace (x2 * (/ sqrt (x1 * x1 + y1 * y1))² * x1² + x2 * (/ sqrt (x1 * x1 + y1 * y1))² * y1²)
with (x2 * (/ sqrt (x1 * x1 + y1 * y1))² * (x1² + y1²)) by ring.
- rewrite R_sqr.Rsqr_inv; trivial; [].
- rewrite Rsqr_sqrt.
+ rewrite R_sqr.Rsqr_inv'; trivial; []. rewrite Rsqr_sqrt.
- unfold Rsqr. field. intro Habs. apply Hnull. rewrite Habs. apply sqrt_0.
- replace 0 with (0 + 0) by ring. apply Rplus_le_compat; apply Rle_0_sqr.
+ ring_simplify. rewrite <- norm_defined in Hnull. unfold norm, inner_product in Hnull. simpl in Hnull.
@@ -446,7 +446,7 @@ intros [x1 y1] Hnull [x2 y2]. unfold unitary, orthogonal, norm, inner_product. s
replace (Rpow_def.pow y1 2) with y1² by (unfold Rsqr; ring).
replace (x2 * (/ sqrt (x1 * x1 + y1 * y1))² * x1² + x2 * (/ sqrt (x1 * x1 + y1 * y1))² * y1²)
with (x2 * (/ sqrt (x1 * x1 + y1 * y1))² * (x1² + y1²)) by ring.
- rewrite R_sqr.Rsqr_inv; trivial; [].
+ rewrite R_sqr.Rsqr_inv'; trivial; [].
rewrite Rsqr_sqrt.
- unfold Rsqr. field. intro Habs. apply Hnull. rewrite Habs. apply sqrt_0.
- replace 0 with (0 + 0) by ring. apply Rplus_le_compat; apply Rle_0_sqr.
@@ -529,7 +529,7 @@ intros t u v w Heq. null (u - t)%VS; [| null (v - t)%VS].
+ split; apply colinear_origin_l || apply colinear_origin_r.
+ split; try apply colinear_origin_r.
rewrite R2sub_origin in Hnull0. rewrite <- Hnull0 in *.
- elim Hnull.
+ contradiction Hnull.
rewrite R2sub_origin, <- dist_defined. apply Rmult_eq_reg_l with 2; try lra; [].
ring_simplify. apply Rplus_eq_reg_r with (dist v w).
rewrite Rplus_0_l. rewrite Heq at 2. setoid_rewrite dist_sym at 3. ring.
@@ -971,7 +971,7 @@ destruct (Rlt_le_dec k kh) as [Hlt | Hle].
right. ring.
left. apply Rle_lt_trans with (r2 := k). tauto.
assumption.
- left. apply Rlt_Rminus. assumption.
+ left. apply Rlt_0_minus. assumption.
destruct A, B; compute; f_equal; ring.
destruct A, B; compute; f_equal; ring.
@@ -1303,7 +1303,7 @@ change ((translation t) (/ k * fold_left add l origin)%VS)
rewrite <- (mul_1 t) at 2. rewrite <- (Rinv_l k); trivial; [].
rewrite <- mul_morph, <- mul_distr_add. f_equiv. change eq with equiv.
subst k. clear Hk. induction l as [| e l].
-* now elim Hl.
+* now contradiction Hl.
* destruct l as [| e' l'].
+ destruct e, t. simpl. f_equal; ring.
+ specialize (IHl ltac:(discriminate)).
@@ -1371,7 +1371,7 @@ Proof using .
(List.map (fun xn => (Bijection.section (Similarity.sim_f sim) (fst xn), snd xn)) m) init
= fold_left (fun acc pt' => acc + snd pt' * (sim.(Similarity.zoom))² * (dist pt (fst pt'))²) m init).
{ intro pt. induction m as [| p1 m]; intro init.
- + now elim Hm.
+ + now contradiction Hm.
+ clear Hm. destruct m as [| p2 m].
* cbn -[dist]. now rewrite sim.(Similarity.dist_prop), R_sqr.Rsqr_mult, Rmult_assoc.
* remember (p2 :: m) as mm.
@@ -1469,12 +1469,12 @@ Proof using .
repeat rewrite ?Rle_bool_true_iff, ?Rle_bool_false_iff in *
; repeat progress normalize_R2dist pt1' pt2' pt3' ;try contradiction;
repeat match goal with
- | H1: ?A < ?A |- _ => elim (Rlt_irrefl _ h_ltxx)
+ | H1: ?A < ?A |- _ => contradiction (Rlt_irrefl _ h_ltxx)
| H1: ?A < ?B, H2: ?B < ?A |- _ =>
- assert (h_ltxx:A<A) by (eapply Rlt_trans;eauto);elim (Rlt_irrefl _ h_ltxx)
+ assert (h_ltxx:A<A) by (eapply Rlt_trans;eauto);contradiction (Rlt_irrefl _ h_ltxx)
| H1: ?A < ?B, H2: ?B < ?C, H3: ?C < ?A |- _ =>
assert (h_ltxx:A<C) by (eapply Rlt_trans;eauto);
- assert (h_ltxx':A<A) by (eapply Rlt_trans;eauto);elim (Rlt_irrefl _ h_ltxx')
+ assert (h_ltxx':A<A) by (eapply Rlt_trans;eauto);contradiction (Rlt_irrefl _ h_ltxx')
| H1:?A <> ?B, H2: ?A <= ?B |- _ => assert (A<B) by (apply Rle_neq_lt;auto);clear H2
| H1:?A <> ?B, H2: ?B <= ?A |- _ => assert (B<A) by (apply Rle_neq_lt;auto;apply not_eq_sym;auto);clear H2
end; reflexivity.
@@ -1512,7 +1512,7 @@ subst; trivial; try contradiction.
+ do 2 right. subst. repeat split; trivial. intro Heq. rewrite Heq in *. intuition.
+ repeat match goal with
| H : dist _ _ = _ |- _ => rewrite H in *; clear H
- | H : ?x <> ?x |- _ => now elim H
+ | H : ?x <> ?x |- _ => now contradiction H
end.
+ left. now repeat split.
Qed.
@@ -1748,7 +1748,7 @@ destruct (equiv_dec pt1 pt2) as [Heq12 | Heq12].
rewrite dist_sym. rewrite dist_defined. auto. }
rewrite norm_orthogonal; trivial; [].
rewrite R_sqr.Rsqr_1, Rmult_1_r. repeat rewrite Rmult_0_r. rewrite Rplus_0_r.
- rewrite dist_sym, norm_dist. setoid_rewrite R_sqr.Rsqr_div; try lra.
+ rewrite dist_sym, norm_dist. setoid_rewrite R_sqr.Rsqr_div'; try lra; [].
unfold Rsqr. intro. assert (Hk : k*k = 0) by lra.
now apply Rsqr_0_uniq.
- unfold middle. destruct pt1, pt2; cbn -[norm]. f_equal; field;
@@ -2049,18 +2049,15 @@ Defined.
Definition enclosing_circle (c : circle) l := forall x, In x l -> dist x (center c) <= (radius c).
Definition on_circle (c : circle) x := Rdec_bool (dist x (center c)) (radius c).
-Instance enclosing_circle_compat : forall c, Proper (@Permutation _ ==> iff) (enclosing_circle c).
+Global Instance enclosing_circle_compat : forall c, Proper (@Permutation _ ==> iff) (enclosing_circle c).
Proof using .
repeat intro. unfold enclosing_circle.
do 2 rewrite <- Forall_forall. apply Forall_Permutation_compat; trivial.
intros ? ? ?. now subst.
Qed.
-Instance on_circle_compat : Proper (equiv ==> equiv ==> eq) on_circle.
-Proof using .
-intros ? ? [Heq1 Heq2] ? ? ?. cbn in *. subst.
-unfold on_circle. now rewrite Heq1, Heq2.
-Qed.
+Global Instance on_circle_compat2 : Proper (eq ==> equiv ==> eq) on_circle.
+Proof using . repeat intro. cbn in *. now subst. Qed.
Lemma on_circle_true_iff : forall c pt, on_circle c pt = true <-> dist pt (center c) = radius c.
Proof using . intros c pt. unfold on_circle. now rewrite Rdec_bool_true_iff. Qed.
@@ -2199,20 +2196,20 @@ Axiom SEC_spec2 : forall l c, enclosing_circle c l -> radius (SEC l) <= radius c
(** Extra specification in the degenerate case. *)
Axiom SEC_nil : radius (SEC nil) = 0.
(** Its definition does not depend on the order of points. *)
-Declare Instance SEC_compat : Proper (@Permutation _ ==> Logic.eq) SEC.
+Global Declare Instance SEC_compat : Proper (@Permutation _ ==> Logic.eq) SEC.
Global Instance SEC_compat_bis : Proper (PermutationA Logic.eq ==> Logic.eq) SEC.
Proof using . intros ? ? Heq. rewrite PermutationA_Leibniz in Heq. now rewrite Heq. Qed.
(* The last axiom is useful because of the following degeneracy fact. *)
Lemma enclosing_circle_nil : forall pt r, enclosing_circle {| center := pt; radius := r |} nil.
-Proof using . intros. unfold enclosing_circle. intros x Hin. elim Hin. Qed.
+Proof using . intros. unfold enclosing_circle. intros x Hin. contradiction Hin. Qed.
Definition center_eq c1 c2 := c1.(center) = c2.(center).
Definition radius_eq c1 c2 := c1.(radius) = c2.(radius).
(** Unicity proof of the radius of the SEC *)
-Instance SEC_radius_compat :
+Global Instance SEC_radius_compat :
Proper (@Permutation _ ==> center_eq) SEC -> Proper (@Permutation _ ==> radius_eq) SEC.
Proof using .
intros Hspec l1 l2 Hperm.
@@ -2235,7 +2232,7 @@ Qed.
(** Points on the SEC. *)
Definition on_SEC l := List.filter (on_circle (SEC l)) l.
-Instance on_SEC_compat : Proper (PermutationA Logic.eq ==> PermutationA Logic.eq) on_SEC.
+Global Instance on_SEC_compat : Proper (PermutationA Logic.eq ==> PermutationA Logic.eq) on_SEC.
Proof using .
intros l1 l2 Hl. unfold on_SEC. rewrite Hl at 2.
rewrite filter_extensionality_compat; try reflexivity.
@@ -2274,7 +2271,7 @@ Lemma max_dist_le : forall pt x l, In x l -> dist x pt <= max_dist pt l.
Proof using .
intros pt x l Hin.
unfold max_dist. generalize 0. induction l as [| e l]; intro acc; simpl.
-* elim Hin.
+* contradiction Hin.
* destruct Hin as [? | Hin]; subst.
+ apply Rle_trans with (Rmax acc (dist x pt)).
- apply Rmax_r.
@@ -2285,7 +2282,7 @@ Qed.
Lemma max_dist_exists : forall pt l, l <> nil -> exists x, In x l /\ dist x pt = max_dist pt l.
Proof using .
intros pt l Hl. induction l as [| e1 l].
-* now elim Hl.
+* now contradiction Hl.
* destruct l as [| e2 l].
+ exists e1. split; try now left. unfold max_dist. simpl. symmetry. apply Rmax_right.
change (0 <= dist e1 pt). apply dist_nonneg.
@@ -2439,12 +2436,12 @@ Lemma farthest_from_in_except_In : forall exc c l, (exists pt, pt <> exc /\ In p
In (farthest_from_in_except exc c c l) l.
Proof using .
intros exc c l Hl. induction l as [| e l].
-* now elim Hl.
+* destruct Hl as [? H]. apply H.
* cbn. destruct (equiv_dec e exc) as [Heq | Heq].
+ rewrite Heq in *. destruct l.
- - destruct Hl as [pt' [Habs Hin]]. elim Habs. now inversion Hin.
+ - destruct Hl as [pt' [Habs Hin]]. contradiction Habs. now inversion Hin.
- right. apply IHl. destruct Hl as [pt' [Hneq Hin]]. exists pt'. split; trivial.
- inversion Hin; subst; trivial; now elim Hneq.
+ inversion Hin; subst; trivial; now contradiction Hneq.
+ destruct (Rle_dec (dist e c) (dist c c)) as [H | H].
- assert (He : equiv e c).
{ rewrite <- dist_defined. transitivity (dist c c).
@@ -2637,7 +2634,7 @@ Qed.
Lemma on_SEC_singleton : forall pt, on_SEC (pt :: nil) = pt :: nil.
Proof using .
intro. cbn. rewrite SEC_singleton. unfold on_circle. cbn. rewrite R2_dist_defined_2.
-destruct (Rdec_bool 0 0) eqn:Htest; trivial. rewrite Rdec_bool_false_iff in Htest. now elim Htest.
+destruct (Rdec_bool 0 0) eqn:Htest; trivial. rewrite Rdec_bool_false_iff in Htest. now contradiction Htest.
Qed.
Lemma on_SEC_singleton_is_singleton : forall pt l, NoDup l -> on_SEC l = pt :: nil -> l = pt :: nil.
@@ -2698,7 +2695,7 @@ destruct (equiv_dec pt1 pt2) as [Heq | Heq].
+ assert (Hperm : exists l, Permutation l' (pt2 :: l)).
{ rewrite <- InA_Leibniz in Hpt2. setoid_rewrite <- PermutationA_Leibniz.
apply PermutationA_split; autoclass.
- inversion_clear Hpt2; trivial. subst. now elim Heq. }
+ inversion_clear Hpt2; trivial. subst. now contradiction Heq. }
destruct Hperm as [l Hperm]. rewrite Hperm in *. clear Hpt2 Hperm l'.
change (/2 * dist pt1 pt2) with (radius {| center := middle pt1 pt2; radius := /2 * dist pt1 pt2 |}).
rewrite <- SEC_dueton. apply SEC_incl_compat. intro. cbn. intuition.
@@ -2765,7 +2762,7 @@ destruct Hl as [Hl | [[pt1 [Hl Hnil]] | [pt1 [pt2 [Hneq [Hpt1 Hpt2]]]]]].
{ assert (Hlen : (length l <> 0)%nat) by auto using length_0.
rewrite Hl. clear Hl Hnil.
induction (length l) as [| [| n]].
- + now elim Hlen.
+ + now contradiction Hlen.
+ simpl. apply SEC_dueton.
+ assert (Hperm : Permutation (pt :: alls pt1 (S (S n))) (pt1 :: pt :: alls pt1 (S n)))
by (simpl; constructor).
@@ -2856,7 +2853,7 @@ destruct Hl as [Hl | [[pt1 [Hl Hnil]] | [pt1 [pt2 [Hneq [Hpt1 Hpt2]]]]]].
- apply Fourier_util.Rle_mult_inv_pos; lra.
- unfold Rdiv. intro Habs. symmetry in Habs. apply Rmult_integral in Habs.
assert (Hlt_inv_d := Rinv_0_lt_compat _ Hlt_d).
- destruct Habs as [? | Habs]; lra || rewrite Rinv_mult_distr in Habs; lra. }
+ destruct Habs as [? | Habs]; lra || rewrite Rinv_mult in Habs; lra. }
assert (Hdist : dist c₂ c₃ = ε / 2).
{ unfold c₃, ratio. rewrite <- add_origin at 1. setoid_rewrite add_comm.
rewrite dist_translation, dist_sym. rewrite norm_dist, opp_origin, add_origin.
@@ -3114,8 +3111,8 @@ destruct (equiv_dec pt1 pt2) as [Heq12 | Heq12];
assert (Hpt2' := Hincl pt2' ltac:(intuition)).
simpl in Hpt1', Hpt2'. decompose [or] Hpt1'; decompose [or] Hpt2'; clear Hpt1' Hpt2'; repeat subst;
try match goal with
- | H : False |- _ => elim H
- | H : ~equiv ?x ?x |- _ => elim H; reflexivity
+ | H : False |- _ => contradiction H
+ | H : ~equiv ?x ?x |- _ => contradiction H; reflexivity
end.
- exists pt3. do 4 constructor.
- exists pt2. do 4 constructor.
@@ -3257,7 +3254,7 @@ repeat match goal with
| H : equiv _ _ |- _ => rewrite H in *
| H : InA _ _ _ |- _ => inversion_clear H
end.
-- now elim Hdiff.
+- now contradiction Hdiff.
- rewrite R2_dist_defined_2 in *. symmetry in Heq2. rewrite dist_defined in Heq2. now symmetry in Heq2.
- rewrite R2_dist_defined_2 in *. now rewrite dist_defined in Heq1.
Qed.
diff --git a/Spaces/RealMetricSpace.v b/Spaces/RealMetricSpace.v
index 3d8336015bc0bf97098781a2b0c32a7ef97ecc56..7e5c1a03d24f7e78aa33db6412ec61e432699908 100644
--- a/Spaces/RealMetricSpace.v
+++ b/Spaces/RealMetricSpace.v
@@ -22,9 +22,9 @@ Class RealMetricSpace (T : Type) {S : Setoid T} `{@EqDec T S} {VS : RealVectorSp
dist_sym : forall u v, dist v u = dist u v;
triang_ineq : forall u v w, (dist u w <= dist u v + dist v w)%R}.
-Arguments dist T%type _ _ _ _ u%VS v%VS.
+Arguments dist T%_type _ _ _ _ u%_VS v%_VS.
-Instance dist_compat `{RealMetricSpace} : Proper (equiv ==> equiv ==> Logic.eq) dist.
+Global Instance dist_compat `{RealMetricSpace} : Proper (equiv ==> equiv ==> Logic.eq) dist.
Proof.
intros x x' Hx y y' Hy. apply Rle_antisym.
+ replace (dist x' y') with (0 + dist x' y' + 0)%R by ring. symmetry in Hy.
@@ -41,7 +41,7 @@ Lemma dist_nonneg `{RealMetricSpace} : forall u v, (0 <= dist u v)%R.
Proof.
intros x y. apply Rmult_le_reg_l with 2%R.
+ apply Rlt_R0_R2.
-+ do 2 rewrite double. rewrite Rplus_0_r.
++ do 2 rewrite <- Rplus_diag. rewrite Rplus_0_r.
assert (Hx : equiv x x) by reflexivity. rewrite <- dist_defined in Hx. rewrite <- Hx.
setoid_rewrite dist_sym at 3. apply triang_ineq.
Qed.
diff --git a/Spaces/RealNormedSpace.v b/Spaces/RealNormedSpace.v
index c49a937ff02f5e72604248ce3e3384c86afb70cc..3547ef0f6c3843fb765d5bebda2b73411c8d737e 100644
--- a/Spaces/RealNormedSpace.v
+++ b/Spaces/RealNormedSpace.v
@@ -30,7 +30,7 @@ Class RealNormedSpace (T : Type) {S : Setoid T} {EQ : @EqDec T S} {VS : RealVect
triang_ineq : forall u v, (norm (add u v) <= norm u + norm v)%R}.
Global Existing Instance norm_compat.
-Arguments norm T%type _ _ _ _ u%VS.
+Arguments norm T%_type _ _ _ _ u%_VS.
Notation "∥ u ∥" := (norm u) : VectorSpace_scope.
(** *** Proofs of derivable properties about RealNormedSpace **)
@@ -379,16 +379,16 @@ Section BarycenterResults.
Proof using .
intros E dm Hnotempty Hdm p Hp.
assert (Hlength_pos: 0 < INR (List.length E)).
- { apply lt_0_INR. destruct E; try (now elim Hnotempty); []. simpl. lia. }
+ { apply lt_0_INR. destruct E; try (now contradiction Hnotempty); []. simpl. lia. }
rewrite norm_dist. subst. unfold isobarycenter.
setoid_replace p%VS with (- / INR (length E) * (- INR (length E) * p))%VS
- by (rewrite mul_morph, Ropp_inv_permute, <- Rinv_l_sym, mul_1; lra || reflexivity).
+ by (rewrite mul_morph, <- Rinv_opp, <- Rinv_l_sym, mul_1; lra || reflexivity).
rewrite <- minus_morph, <- mul_distr_add, norm_mul, Rabs_Ropp, Rabs_right;
try (now apply Rle_ge, Rlt_le, Rinv_0_lt_compat); [].
apply Rmult_le_reg_l with (r := INR (length E)); trivial; [].
rewrite <- Rmult_assoc, Rinv_r, Rmult_1_l; try lra; [].
induction E as [| a [| b E]].
- + now elim Hnotempty.
+ + now contradiction Hnotempty.
+ specialize (Hp a ltac:(now left)). cbn -[mul add norm].
setoid_replace ((-(1) * p) + (0 + a))%VS with (a - p)%VS
by now rewrite add_origin_l, add_comm, minus_morph, mul_1.
@@ -421,4 +421,4 @@ Section BarycenterResults.
End BarycenterResults.
-Arguments unitary {T%type} {_} {_} {_} {_} u%VS.
+Arguments unitary {T%_type} {_} {_} {_} {_} u%_VS.
diff --git a/Spaces/RealVectorSpace.v b/Spaces/RealVectorSpace.v
index 565bf57b4d2abf11b29b470f49413cd36eb0303f..53c8c624460554a082c3a9bfa6666ff3aaf26c94 100644
--- a/Spaces/RealVectorSpace.v
+++ b/Spaces/RealVectorSpace.v
@@ -51,17 +51,17 @@ Global Existing Instance opp_compat.
Declare Scope VectorSpace_scope.
Delimit Scope VectorSpace_scope with VS.
-Arguments add T%type _ _ _ u%VS v%VS.
-Arguments mul T%type _ _ _ k%R u%VS.
-Arguments opp T%type _ _ _ u%VS.
-Arguments add_assoc {T} {_} {_} {_} u%VS v%VS w%VS.
-Arguments add_comm {T} {_} {_} {_} u%VS v%VS.
-Arguments add_origin {T} {_} {_} {_} u%VS.
-Arguments add_opp {T} {_} {_} {_} u%VS.
-Arguments mul_distr_add {T} {_} {_} {_} a%R u%VS v%VS.
-Arguments mul_morph {T} {_} {_} {_} a%R b%R u%VS.
-Arguments add_morph {T} {_} {_} {_} a%R b%R u%VS.
-Arguments mul_1 {T} {_} {_} {_} u%VS.
+Arguments add T%_type _ _ _ u%_VS v%_VS.
+Arguments mul T%_type _ _ _ k%_R u%_VS.
+Arguments opp T%_type _ _ _ u%_VS.
+Arguments add_assoc {T} {_} {_} {_} u%_VS v%_VS w%_VS.
+Arguments add_comm {T} {_} {_} {_} u%_VS v%_VS.
+Arguments add_origin {T} {_} {_} {_} u%_VS.
+Arguments add_opp {T} {_} {_} {_} u%_VS.
+Arguments mul_distr_add {T} {_} {_} {_} a%_R u%_VS v%_VS.
+Arguments mul_morph {T} {_} {_} {_} a%_R b%_R u%_VS.
+Arguments add_morph {T} {_} {_} {_} a%_R b%_R u%_VS.
+Arguments mul_1 {T} {_} {_} {_} u%_VS.
Notation "0" := (origin) : VectorSpace_scope.
Notation "u + v" := (add u v) : VectorSpace_scope.
@@ -146,14 +146,14 @@ Proof using .
intros k k' u Hu Heq. destruct (Rdec k k') as [| Hneq]; trivial.
assert (Heq0 : (k - k') * u == 0).
{ unfold Rminus. rewrite <- add_morph, minus_morph, Heq. apply add_opp. }
-elim Hu. rewrite <- (mul_1 u). rewrite <- (Rinv_l (k - k')).
+contradiction Hu. rewrite <- (mul_1 u). rewrite <- (Rinv_l (k - k')).
- rewrite <- mul_morph. rewrite Heq0. apply mul_origin.
- intro Habs. apply Hneq. now apply Rminus_diag_uniq.
Qed.
Definition middle `{RealVectorSpace} u v := (1/2) * (u + v).
-Instance middle_compat `{RealVectorSpace} : Proper (equiv ==> equiv ==> equiv) middle.
+Global Instance middle_compat `{RealVectorSpace} : Proper (equiv ==> equiv ==> equiv) middle.
Proof using . intros u1 u2 Hu v1 v2 Hv. unfold middle. now rewrite Hu, Hv. Qed.
Lemma mul_integral `{RealVectorSpace} : forall k u, k * u == 0 -> k = 0%R \/ u == 0.
@@ -174,7 +174,7 @@ abstract (intros x y Hxy; apply add_compat; try reflexivity; [];
apply mul_compat; try apply Hxy; []; apply add_compat, opp_compat; reflexivity).
Defined.
-Instance straight_path_compat {T} `{RealVectorSpace T} :
+Global Instance straight_path_compat {T} `{RealVectorSpace T} :
Proper (equiv ==> equiv ==> equiv) straight_path.
Proof using .
intros pt1 pt2 Heq pt1' pt2' Heq' x. simpl.
@@ -191,7 +191,7 @@ refine (Build_path _ _ (fun x => @mul _ _ _ RVS x pt) _).
abstract (intros x y Hxy; apply mul_compat; reflexivity || apply Hxy).
Defined.
-Instance local_straight_path_compat {T} `{RealVectorSpace T} :
+Global Instance local_straight_path_compat {T} `{RealVectorSpace T} :
Proper (equiv ==> equiv) local_straight_path.
Proof using . intros pt1 pt2 Heq x. simpl. now apply mul_compat. Qed.
@@ -265,7 +265,7 @@ Section Barycenter.
0 < snd (barycenter_aux E init).
Proof using .
intros E init Hinit Hnil HE.
- destruct E as [| e E]; try (now elim Hnil); [].
+ destruct E as [| e E]; try (now contradiction Hnil); [].
simpl. apply Rlt_le_trans with (snd e + snd init)%R.
+ inv HE. lra.
+ change (snd e + snd init)%R with (snd ((snd e * fst e + fst init)%VS, snd e + snd init))%R.
diff --git a/Spaces/Ring.v b/Spaces/Ring.v
index 839f8843878b19ab2439a589a2296f4b5070f75c..b9368aa0dac8d4f1b963c4cc691c3767a990cbd2 100644
--- a/Spaces/Ring.v
+++ b/Spaces/Ring.v
@@ -8,428 +8,577 @@
*)
(**************************************************************************)
+Require Import Utf8 Lia Psatz SetoidDec Rbase.
+From Pactole Require Import Util.Coqlib Util.Bijection Spaces.Graph
+ Spaces.Isomorphism Models.NoByzantine Util.Fin.
-Require Import Lia Psatz SetoidDec Rbase.
-Require Import Pactole.Util.Coqlib.
-Require Import Pactole.Core.Identifiers.
-Require Export Pactole.Spaces.Graph.
-Require Import Pactole.Spaces.Isomorphism.
+(** ** A ring **)
+Inductive direction := Forward | Backward | SelfLoop.
-Typeclasses eauto := (bfs).
-Remove Hints eq_setoid : typeclass_instances.
+Global Instance direction_Setoid : Setoid direction := eq_setoid direction.
-(** ** A ring **)
+Lemma direction_eq_dec_subproof : ∀ d1 d2 : direction, {d1 = d2} + {d1 <> d2}.
+Proof using . decide equality. Defined.
+
+Global Instance direction_EqDec : EqDec direction_Setoid
+ := direction_eq_dec_subproof.
+
+(* Returns the nat to give as parameter to
+ addm to translate in the direction dir *)
+Definition dir2nat {n : nat} {ltc_2_n : 2 <c n} (d : direction) : nat :=
+ match d with
+ | SelfLoop => 0
+ | Forward => 1
+ | Backward => Nat.pred n
+ end.
-(** What we need to define a ring. *)
-Class RingSpec := {
- ring_size : nat;
- ring_size_spec : 1 < ring_size }.
-Coercion ring_size_spec : RingSpec >-> lt.
+(* ''inverse'' of dir2nat *)
+Definition nat2Odir {n : nat} {ltc_2_n : 2 <c n} (m : nat) : option direction :=
+ match m with
+ | 0 => Some SelfLoop
+ | 1 => Some Forward
+ | _ => if m =? Nat.pred n then Some Backward else None
+ end.
+
+Global Instance ltc_1_n {n : nat} {ltc_2_n : 2 <c n} : 1 <c n
+ := (lt_s_u 1 ltac:(auto)).
+
+Definition ring_edge {n : nat} {ltc_2_n : 2 <c n} := (fin n * direction)%type.
Section Ring.
-Context {RR : RingSpec}.
-Notation ring_node := (finite_node ring_size).
+Context {n : nat} {ltc_2_n : 2 <c n}.
-Inductive direction := Forward | Backward | SelfLoop.
-Definition ring_edge := (ring_node * direction)%type.
-
-Global Instance direction_Setoid : Setoid direction.
-simple refine {|
- equiv := fun d1 d2 => if (Nat.eq_dec ring_size 2)
- then match d1, d2 with
- | SelfLoop, SelfLoop => True
- | SelfLoop, _ | _, SelfLoop => False
- | _, _ => True
- end
- else d1 = d2 |}; trivial; [].
-Proof. split.
-+ intro. repeat destruct_match; reflexivity.
-+ intros ? ? ?. repeat destruct_match; auto; now symmetry.
-+ intros ? ? ?. repeat destruct_match; auto; congruence.
-Defined.
+Global Instance ring_edge_Setoid : Setoid ring_edge := eq_setoid ring_edge.
+
+Lemma ring_edge_dec : ∀ e1 e2 : ring_edge, {e1 = e2} + {e1 ≠e2}.
+Proof using . apply pair_dec. apply fin_EqDec. apply direction_EqDec. Qed.
+
+Global Instance ring_edge_EqDec : EqDec ring_edge_Setoid := ring_edge_dec.
+
+Definition dir2nat_compat : Proper (equiv ==> equiv) dir2nat := _.
+
+Lemma dir20 : dir2nat SelfLoop = 0.
+Proof using . reflexivity. Qed.
+
+Lemma dir21 : dir2nat Forward = 1.
+Proof using . reflexivity. Qed.
+
+Lemma dir2pred_n : dir2nat Backward = Nat.pred n.
+Proof using . reflexivity. Qed.
+
+Lemma dir2nat_lt : ∀ d : direction, dir2nat d < n.
+Proof using .
+ intros. destruct d. all: cbn. 2: apply lt_pred_u.
+ all: apply lt_s_u. all: auto.
+Qed.
+
+Lemma dir2natI : Util.Preliminary.injective equiv equiv dir2nat.
+Proof using .
+ intros d1 d2 H'. destruct d1, d2. all: inversion H' as [H].
+ all: try reflexivity. all: exfalso. 1,4: symmetry in H.
+ all: eapply neq_pred_u_s. 2,4,6,8: exact H. all: auto.
+Qed.
-Global Instance ring_edge_Setoid : Setoid ring_edge := prod_Setoid _ _.
-
-Lemma direction_eq_dec : forall d d': direction, {d = d'} + {d <> d'}.
-Proof. decide equality. Defined.
-
-Global Instance direction_EqDec : EqDec direction_Setoid.
- refine (fun d1 d2 => if (Nat.eq_dec ring_size 2)
- then match d1, d2 with
- | SelfLoop, SelfLoop => left _
- | SelfLoop, _ | _, SelfLoop => right _
- | _, _ => left _
- end
- else _); simpl; try rewrite e; simpl; try tauto.
-Proof.
-abstract (repeat destruct_match; tauto || apply direction_eq_dec).
+Definition nat2Odir_compat : Proper (equiv ==> equiv) nat2Odir := _.
+
+Lemma nat2Odir_Some : ∀ (d : direction) (m : nat),
+ nat2Odir m = Some d <-> dir2nat d = m.
+Proof using .
+ unfold dir2nat, nat2Odir. intros d m. split; intros H.
+ all: destruct d, m as [|p]. all: try inversion H. all: try reflexivity.
+ 4:{ exfalso. eapply neq_pred_u_s. 2: exact H. auto. }
+ 4: rewrite Nat.eqb_refl. all: destruct p. all: try inversion H.
+ all: try reflexivity. 4:{ exfalso. eapply neq_pred_u_s. 2: exact H.
+ auto. } all: destruct (S (S p) =? Nat.pred n) eqn:Hd.
+ all: try inversion H. symmetry. apply Nat.eqb_eq, Hd.
+Qed.
+
+Lemma nat2Odir_None : ∀ m : nat,
+ nat2Odir m = None <-> (∀ d : direction, dir2nat d ≠m).
+Proof using .
+ intros. split; intros H.
+ - intros d Habs. apply nat2Odir_Some in Habs. rewrite H in Habs.
+ inversion Habs.
+ - destruct (nat2Odir m) eqn:Hd. 2: reflexivity. exfalso.
+ apply (H d), nat2Odir_Some, Hd.
+Qed.
+
+Lemma nat2Odir_pick : ∀ m : nat,
+ pick_spec (λ d : direction, dir2nat d = m) (nat2Odir m).
+Proof using .
+ intros. apply pick_Some_None. intros d.
+ all: rewrite opt_Setoid_eq by reflexivity.
+ apply nat2Odir_Some. apply nat2Odir_None.
+Qed.
+
+Definition nat2dir (m : nat) (H : ∃ d, dir2nat d = m) : direction.
+Proof using .
+ destruct (nat2Odir_pick m) as [d Hd | Hd]. exact d.
+ abstract (exfalso; destruct H as [d H]; apply (Hd d), H).
Defined.
-Global Instance ring_edge_EqDec : EqDec ring_edge_Setoid := prod_EqDec _ _.
+Lemma dir2natK : ∀ (d1 : direction) (H : ∃ d2, dir2nat d2 = dir2nat d1),
+ nat2dir (dir2nat d1) H = d1.
+Proof using .
+ intros. unfold nat2dir. destruct (nat2Odir_pick (dir2nat d1)) as [m Hd | Hd].
+ eapply dir2natI, Hd. contradiction (Hd d1). reflexivity.
+Qed.
+
+Lemma nat2dirK :
+ ∀ (m : nat) (H : ∃ d, dir2nat d = m), dir2nat (nat2dir m H) = m.
+Proof using .
+ intros. unfold nat2dir. destruct (nat2Odir_pick m) as [g Hd | Hd].
+ exact Hd. exfalso. destruct H as [d H]. apply (Hd d). exact H.
+Qed.
+
+(* Returns the fin n to give as parameter to
+ addf to translate in the direction dir *)
+Definition dir2nod (d : direction) : fin n := Fin (dir2nat_lt d).
-(* the following lemmas are used to easily prove that
- (Z.to_nat (l mod Z.of_nat n)) = (l mod Z.of_nat n) *)
-Lemma to_Z_sup_0 : forall l : Z, (0 <= l mod Z.of_nat ring_size)%Z.
-Proof using . intros. apply Zdiv.Z_mod_lt. destruct RR. simpl. lia. Qed.
+(* ''inverse'' of dir2nat *)
+Definition nod2Odir (v : fin n) : option direction := nat2Odir v.
-Lemma to_Z_inf_n (x : Z): Z.to_nat (x mod Z.of_nat ring_size)%Z < ring_size.
+Definition dir2nod_compat : Proper (equiv ==> equiv) dir2nod := _.
+
+Definition nod2Odir_compat : Proper (equiv ==> equiv) nod2Odir := _.
+
+Lemma dir2nod2nat : ∀ d : direction, dir2nod d = dir2nat d :> nat.
+Proof using . reflexivity. Qed.
+
+Lemma dir2nodE : ∀ d : direction, dir2nod d = mod2fin (dir2nat d).
Proof using .
-intros. rewrite <- Nat2Z.id, <- Z2Nat.inj_lt;
-try apply Zdiv.Z_mod_lt; destruct RR; simpl; lia.
+ intros. apply fin2natI. rewrite dir2nod2nat.
+ symmetry. apply mod2fin_small, dir2nat_lt.
Qed.
-Definition to_Z (v : ring_node) : Z := Z.of_nat (proj1_sig v).
-Definition of_Z (x : Z) : ring_node :=
- exist _ (Z.to_nat (x mod Z.of_nat ring_size)) (to_Z_inf_n x).
+Lemma nod2OdirE : ∀ v : fin n, nod2Odir v = nat2Odir v.
+Proof using . reflexivity. Qed.
-Global Instance to_Z_compat : Proper (equiv ==> Z.eq) to_Z.
-Proof using . repeat intro. hnf in *. now f_equal. Qed.
+Lemma dir2fin0 : dir2nod SelfLoop = fin0.
+Proof using . apply fin2natI. rewrite dir2nod2nat. apply dir20. Qed.
-Global Instance of_Z_compat : Proper (Z.eq ==> equiv) of_Z.
-Proof using . intros ? ? Heq. now rewrite Heq. Qed.
+Lemma dir2fin1 : dir2nod Forward = fin1.
+Proof using .
+ apply fin2natI. symmetry. rewrite dir2nod2nat, dir21. apply fin12nat.
+Qed.
-Lemma to_Z_injective : Preliminary.injective equiv Logic.eq to_Z.
+Lemma dir2max : dir2nod Backward = fin_max.
+Proof using . apply fin2natI. rewrite dir2nod2nat. apply dir2pred_n. Qed.
+
+Lemma dir2nodI : Util.Preliminary.injective equiv equiv dir2nod.
Proof using .
-intros [x Hx] [y Hy] Heq.
-unfold to_Z in Heq. hnf in Heq |- *. simpl in Heq.
-apply Nat2Z.inj in Heq. subst. f_equal. apply le_unique.
+ intros d1 d2 H. apply dir2natI. rewrite <-2 dir2nod2nat, H. reflexivity.
Qed.
-Lemma to_Z_small : forall v, (0 <= to_Z v < Z.of_nat ring_size)%Z.
-Proof using . intro. unfold to_Z. split; try lia; []. apply Nat2Z.inj_lt. apply proj2_sig. Qed.
+Lemma nod2Odir_Some : ∀ (d : direction) (v : fin n),
+ nod2Odir v = Some d <-> dir2nod d = v.
+Proof using .
+ intros. rewrite nod2OdirE. split. all: intros H. apply fin2natI,
+ nat2Odir_Some, H. apply nat2Odir_Some. rewrite <- dir2nod2nat, H. reflexivity.
+Qed.
-Lemma Z2Z : forall l, (to_Z (of_Z l) = l mod Z.of_nat ring_size)%Z.
+Lemma nod2Odir_None : ∀ v : fin n,
+ nod2Odir v = None <-> (∀ d : direction, dir2nod d ≠v).
Proof using .
-intros. unfold to_Z, of_Z. simpl.
-rewrite Z2Nat.id; trivial; [].
-apply Z.mod_pos_bound. destruct RR. simpl. lia.
+ intros. rewrite nod2OdirE. split.
+ - intros H d Habs. eapply (proj1 (nat2Odir_None _)). apply H.
+ rewrite <- Habs. symmetry. apply dir2nod2nat.
+ - intros H. apply nat2Odir_None. intros d Habs. apply (H d), fin2natI, Habs.
Qed.
-Lemma V2V : forall v, of_Z (to_Z v) == v.
+Lemma nod2Odir_pick : ∀ v : fin n,
+ pick_spec (λ d : direction, dir2nod d = v) (nod2Odir v).
Proof using .
-intros [k Hk]. hnf. unfold to_Z, of_Z. apply eq_proj1. simpl.
-rewrite <- Zdiv.mod_Zmod, Nat2Z.id, Nat.mod_small; lia.
+ intros. apply pick_Some_None. intros d.
+ all: rewrite opt_Setoid_eq by reflexivity.
+ apply nod2Odir_Some. apply nod2Odir_None.
+Qed.
+
+Definition nod2dir (v : fin n) (H : ∃ d, dir2nod d = v) : direction.
+Proof using .
+ apply (nat2dir v). abstract (destruct H as [d H]; exists d;
+ rewrite <- H; symmetry; apply dir2nod2nat).
+Defined.
+
+Lemma dir2nodK : ∀ (d1 : direction) (H : ∃ d2, dir2nod d2 = dir2nod d1),
+ nod2dir (dir2nod d1) H = d1.
+Proof using . intros. erewrite <- (dir2natK d1). reflexivity. Qed.
+
+Lemma nod2dirK :
+ ∀ (v : fin n) (H : ∃ d, dir2nod d = v), dir2nod (nod2dir v H) = v.
+Proof using .
+ intros. apply fin2natI. erewrite <- (nat2dirK v). reflexivity.
Qed.
(** From a node, if we move in one direction, get get to another node. *)
-Definition move_along (v : ring_node) (dir : direction) :=
- match dir with
- | SelfLoop => v
- | Forward => of_Z (to_Z v + 1)
- | Backward => of_Z (to_Z v - 1)
+Definition move_along (v : fin n) (d : direction)
+ := addf v (dir2nod d).
+
+Definition move_along_compat :
+ Proper (equiv ==> equiv ==> equiv) move_along := _.
+
+Lemma move_alongE : ∀ (v : fin n) (d : direction),
+ move_along v d = addf v (dir2nod d).
+Proof using . intros. reflexivity. Qed.
+
+Definition move_along2nat : ∀ (v : fin n) (d : direction),
+ fin2nat (move_along v d) = (v + dir2nat d) mod n.
+Proof using . intros. apply addf2nat. Qed.
+
+Lemma move_alongI_ : ∀ d : direction,
+ Util.Preliminary.injective equiv equiv (λ v, move_along v d).
+Proof using . intros. apply addIf. Qed.
+
+Lemma move_along_I : ∀ v : fin n,
+ Util.Preliminary.injective equiv equiv (move_along v).
+Proof using . intros v d1 d2 H. eapply dir2nodI, addfI, H. Qed.
+
+Lemma move_along_0 : ∀ v : fin n, move_along v SelfLoop = v.
+Proof using . apply addf0. Qed.
+
+Lemma move_along0_ : ∀ d : direction, move_along fin0 d = dir2nod d.
+Proof using . intros. rewrite move_alongE. apply add0f. Qed.
+
+Lemma move_alongAC : ∀ (v : fin n) (d1 d2 : direction),
+ move_along (move_along v d2) d1 = move_along (move_along v d1) d2.
+Proof using . intros. rewrite 4 move_alongE. apply addfAC. Qed.
+
+Lemma addm_move_along : ∀ (v : fin n) (m : nat) (d : direction),
+ addm (move_along v d) m = move_along (addm v m) d.
+Proof using . intros. rewrite 2 move_alongE, 2 addm_addf. apply addfAC. Qed.
+
+Lemma subm_move_along : ∀ (v : fin n) (m : nat) (d : direction),
+ subm (move_along v d) m = move_along (subm v m) d.
+Proof using . intros. rewrite 2 move_alongE, 2 submE. apply addfAC. Qed.
+
+Lemma addf_move_along : ∀ (v1 v2 : fin n) (d : direction),
+ addf (move_along v1 d) v2 = move_along (addf v1 v2) d.
+Proof using . intros. rewrite 2 move_alongE. apply addfAC. Qed.
+
+Lemma subf_move_along : ∀ (v1 v2 : fin n) (d : direction),
+ subf v2 (move_along v1 d) = subf (subf v2 v1) (dir2nod d).
+Proof using . intros. rewrite move_alongE. apply subf_addf. Qed.
+
+Lemma subf_move_along' : ∀ (v1 v2 : fin n) (d : direction),
+ subf (move_along v1 d) v2 = move_along (subf v1 v2) d.
+Proof using . intros. rewrite 2 move_alongE, 2 subfE. apply addfAC. Qed.
+
+(* returns the ''opposite'' direction *)
+Definition swap_direction (d : direction) :=
+ match d with
+ | Forward => Backward
+ | Backward => Forward
+ | SelfLoop => SelfLoop
end.
-Global Instance move_along_compat : Proper (equiv ==> equiv ==> equiv) move_along.
+Definition swap_direction_compat :
+ Proper (equiv ==> equiv) swap_direction := _.
+
+Lemma swap_directionI :
+ Util.Preliminary.injective equiv equiv swap_direction.
+Proof using .
+ unfold swap_direction. intros d1 d2 H. destruct d1, d2.
+ all: try inversion H. all: reflexivity.
+Qed.
+
+Lemma swap_directionK : ∀ d : direction,
+ swap_direction (swap_direction d) == d.
+Proof using .
+ intros d. unfold swap_direction. destruct d. all: reflexivity.
+Qed.
+
+Definition swbd : bijection direction
+ := cancel_bijection swap_direction _ swap_directionI
+ swap_directionK swap_directionK.
+
+Lemma swbdE : swbd = swap_direction :> (direction -> direction).
+Proof using . reflexivity. Qed.
+
+Lemma swbdVE : swbdâ»Â¹ = swap_direction :> (direction -> direction).
+Proof using . reflexivity. Qed.
+
+Lemma swbdV : swbdâ»Â¹ == swbd.
+Proof using . intros dir. rewrite swbdE, swbdVE. reflexivity. Qed.
+
+Lemma swbdK : swbd ∘ swbd == Bijection.id.
+Proof using . intros dir. rewrite compE, swbdE. apply swap_directionK. Qed.
+
+Lemma dir2nod_swap_direction : ∀ d : direction,
+ dir2nod (swap_direction d) = oppf (dir2nod d).
+Proof using .
+ intros. destruct d. all: cbn. all: symmetry. 1,2: rewrite dir2max, dir2fin1.
+ apply oppf1. apply oppf_max. rewrite dir2fin0. apply oppf0.
+Qed.
+
+Lemma move_along_swap_direction : ∀ (v : fin n) (d : direction),
+ move_along v (swap_direction d) = subf v (dir2nod d).
+Proof using .
+ intros. rewrite move_alongE, dir2nod_swap_direction. symmetry. apply subfE.
+Qed.
+
+Lemma move_alongK' : ∀ (v : fin n) (d : direction),
+ subf (move_along v d) (dir2nod d) = v.
+Proof using . intros. rewrite move_alongE. apply addfVKV. Qed.
+
+Lemma submVKV' : ∀ (v : fin n) (d : direction),
+ move_along (subf v (dir2nod d)) d = v.
+Proof using . intros. rewrite move_alongE. apply subfVKV. Qed.
+
+Lemma move_alongK : ∀ (v : fin n) (d : direction),
+ move_along (move_along v d) (swap_direction d) = v.
+Proof using .
+ intros. rewrite move_along_swap_direction. apply move_alongK'.
+Qed.
+
+Lemma move_along_dir2nod_subf : ∀ (v1 v2 : fin n) (d : direction),
+ dir2nod d = subf v2 v1 <-> move_along v1 d = v2.
+Proof using .
+ intros. rewrite move_alongE. split; intros H. rewrite H. apply subfVK.
+ rewrite <- H. symmetry. apply addfKV.
+Qed.
+
+Lemma symf_move_along : ∀ (c v : fin n) (d : direction),
+ symf c (move_along v d) = move_along (symf c v) (swap_direction d).
+Proof using .
+ intros. rewrite move_along_swap_direction, move_alongE. apply symf_addf.
+Qed.
+
+Lemma move_along_symf : ∀ (v1 v2 : fin n) (d : direction),
+ move_along (symf v1 v2) d = symf v1 (move_along v2 (swap_direction d)).
Proof using .
-intros v1 v2 Hv e1 e2. simpl in *. unfold move_along. subst.
-destruct (Nat.eq_dec ring_size 2) as [Hsize | Hsize];
-repeat destruct_match; try tauto || discriminate; [|];
-intros _; unfold of_Z; apply eq_proj1; simpl; rewrite Hsize; simpl;
-assert (Hv2 := proj2_sig v2);
-destruct v2 as [[| [| [| v]]] ?]; simpl in *; lia.
+ intros. rewrite symf_move_along, swap_directionK. reflexivity.
Qed.
-Definition Ring (thd : ring_edge -> R)
- (thd_pos : forall e, (0 < thd e < 1)%R)
- (thd_compat : Proper (equiv ==> Logic.eq) thd)
- : FiniteGraph ring_size (ring_edge).
-Proof.
-refine ({|
+Lemma nod2Odir_subf_Some :
+ ∀ (v1 v2 : fin n) (d : direction), nod2Odir (subf v1 v2) = Some d
+ <-> nod2Odir (subf v2 v1) = Some (swap_direction d).
+Proof using .
+ intros. rewrite 2 nod2Odir_Some, dir2nod_swap_direction, <- (oppf_subf v2).
+ symmetry. apply injective_eq_iff, oppfI.
+Qed.
+
+Lemma nod2Odir_subf_None : ∀ v1 v2 : fin n,
+ nod2Odir (subf v2 v1) = None <-> ∀ d : direction, move_along v1 d ≠v2.
+Proof using .
+ intros. rewrite nod2Odir_None. split. all: intros H d Heq. all: apply (H d).
+ all: apply move_along_dir2nod_subf, Heq.
+Qed.
+
+Definition find_edge_subterm (v1 v2 : fin n) : option ring_edge
+ := match (nod2Odir (subf v2 v1)) with
+ | Some d1 => Some (v1, d1)
+ | None => None
+ end.
+
+Lemma find_edge_subproof :
+ ∀ (e : ring_edge) (v1 v2 : fin n), find_edge_subterm v1 v2 == Some e
+ <-> v1 == fst e /\ v2 == move_along (fst e) (snd e).
+Proof using .
+ intros. rewrite opt_Setoid_eq by reflexivity. unfold find_edge_subterm.
+ cbn. rewrite (eq_sym_iff v2), <- move_along_dir2nod_subf.
+ destruct (nod2Odir_pick (subf v2 v1)) as [d Hd|Hd].
+ - rewrite (injective_eq_iff Some_eq_inj), <- (pair_eqE (v1, d)). cbn[fst snd].
+ split. all: intros [H1 H2]. all: subst. all: split; [reflexivity |].
+ apply Hd. apply dir2nodI. rewrite H2. apply Hd.
+ - split. intros H. inversion H. intros [? H]. subst. exfalso. eapply Hd, H.
+Qed.
+
+Global Instance Ring : Graph (fin n) ring_edge := {|
+ V_EqDec := @fin_EqDec n;
+ E_EqDec := ring_edge_EqDec;
src := fst;
- tgt := fun e => move_along (fst e) (snd e);
- threshold := thd;
- find_edge := fun v1 v2 => if v1 =?= of_Z (to_Z v2 + 1) then Some (v1, Backward) else
- if of_Z (to_Z v1 + 1) =?= v2 then Some (v1, Forward) else
- if v1 =?= v2 then Some (v1, SelfLoop) else None;
- V_EqDec := @finite_node_EqDec ring_size;
- E_EqDec := ring_edge_EqDec |}).
-* exact thd_pos.
-* (* src_compat *)
- intros e1 e2 He. apply He.
-* (* tgt_compat *)
- intros e1 e2 [Ht Hd]. apply eq_proj1.
- repeat rewrite Ht. clear Ht. revert Hd.
- simpl. repeat destruct_match; simpl; intro;
- try tauto || discriminate; [| |];
- try (destruct (fst e2) as [k ?]; unfold to_Z; simpl;
- match goal with H : ring_size = 2 |- _ => try rewrite H in *; clear H end;
- destruct k as [| [| k]]; simpl; lia); [].
- rewrite move_along_compat; trivial; try rewrite Hd; reflexivity.
-(* * (* find_edge_compat *)
- intros v1 v2 Hv12 v3 v4 Hv34. hnf in *. subst.
- repeat destruct_match; hnf in *; simpl in *; try easy || congruence; [| |];
- (split; trivial; []); now destruct_match. *)
-Open Scope Z_scope.
-* (* find_edge_None *)
- assert (Hsize := ring_size_spec).
- unfold move_along.
- intros a b; split; unfold find_edge;
- destruct (a =?= of_Z (to_Z b + 1)) as [Heq_a | Hneq_a].
- + tauto.
- + destruct (of_Z (to_Z a + 1) =?= b) as [Heq_b | Hneq_b], (a =?= b); try tauto; [].
- intros _ e [Hsrc Htgt].
- destruct (snd e); rewrite Hsrc in Htgt.
- - hnf in *. subst b. intuition.
- - elim Hneq_a. rewrite <- Htgt. rewrite Z2Z. apply eq_proj1.
- unfold of_Z. simpl. rewrite Zdiv.Zplus_mod_idemp_l.
- ring_simplify (to_Z a - 1 + 1).
- unfold to_Z. rewrite <- Zdiv.mod_Zmod, Nat2Z.id, Nat.mod_small; try lia; [].
- apply proj2_sig.
- - contradiction.
- + intros Hedge. elim (Hedge (a, Backward)).
- split; simpl; try reflexivity; [].
- rewrite Heq_a, Z2Z. apply eq_proj1.
- unfold Z.sub, of_Z. simpl. rewrite Zdiv.Zplus_mod_idemp_l.
- ring_simplify (to_Z b + 1 + -1).
- unfold to_Z. rewrite <- Zdiv.mod_Zmod, Nat2Z.id, Nat.mod_small; lia || apply proj2_sig.
- + intro Hedge. destruct (of_Z (to_Z a + 1) =?= b) as [Heq_b | Hneq_b].
- - elim (Hedge (a, Forward)).
- split; simpl; try reflexivity; []. now rewrite <- Heq_b.
- - destruct (a =?= b) as [Heq |]; try reflexivity; [].
- elim (Hedge (a, SelfLoop)).
- split; simpl; try reflexivity; []. apply Heq.
-* (* find_edge_Some *)
- assert (Hsize_pos := ring_size_spec).
- unfold move_along.
- clear dependent thd.
- intros v1 v2 e.
- simpl in *. repeat (destruct_match; simpl in *); subst;
- match goal with
- | H : ring_size = 2%nat |- _ => rename H into Hsize
- | H : ring_size <> 2%nat |- _ => rename H into Hsize
- end;
- destruct e as [v dir]; simpl in *; split; intros []; subst;
- try split; try tauto || discriminate.
- + apply eq_proj1. unfold of_Z, to_Z. simpl.
- destruct v2 as [[| [| ?]] ?]; simpl; rewrite Hsize; simpl; lia.
- + apply eq_proj1. unfold of_Z, to_Z. simpl.
- destruct v2 as [[| [| ?]] ?]; simpl; rewrite Hsize; simpl; lia.
- + unfold of_Z, to_Z in *. destruct v2 as [v2 ?]; simpl in *; rewrite Hsize in *; simpl in *.
- match goal with H : exist _ _ _ = _ |- _ => rename H into Heq end.
- apply (f_equal (@proj1_sig _ _)) in Heq. simpl in Heq. rewrite Hsize in *.
- destruct v2 as [| [| ?]]; simpl in *; lia.
- + apply eq_proj1. destruct v as [v Hv]. unfold of_Z, to_Z. simpl. rewrite Hsize in *.
- destruct v as [| [| ?]]; simpl; lia.
- + match goal with H : _ = v |- _ => rename H into Heq end.
- apply (f_equal (@proj1_sig _ _)) in Heq.
- unfold to_Z, of_Z in Heq. destruct v as [v Hv]. simpl in Heq.
- rewrite Hsize in *. destruct v as [| [| ?]]; simpl in *; lia || lia.
- + match goal with H : v = _ |- _ => rename H into Heq end.
- apply (f_equal (@proj1_sig _ _)) in Heq.
- unfold to_Z, of_Z in Heq. destruct v as [v Hv]. simpl in Heq.
- rewrite Hsize in *. destruct v as [| [| ?]]; simpl in *; lia || lia.
- + match goal with H : of_Z (to_Z v + 1) = of_Z (to_Z v - 1) -> False |- _ => apply H end.
- apply eq_proj1. unfold of_Z, to_Z. simpl.
- rewrite <- (Zdiv.Z_mod_plus_full (_ - 1) 1 (Z.of_nat ring_size)).
- do 2 f_equal. destruct v as [v ?]; simpl; rewrite Hsize; simpl. ring.
- + exfalso. match goal with H : _ = _ |- _ => rename H into Heq end.
- apply (f_equal to_Z) in Heq. symmetry in Heq. revert Heq.
- rewrite 2 Z2Z. destruct v2 as [v2 ?]. unfold of_Z, to_Z. simpl.
- rewrite Zdiv.Zplus_mod_idemp_l.
- rewrite <- (Z.mod_small (Z.of_nat v2) (Z.of_nat ring_size)) at 2; try lia; [].
- replace (Z.of_nat v2 + 1 + 1) with (Z.of_nat v2 + 2) by ring.
- apply Zadd_small_mod_non_conf. lia.
- + rewrite Z2Z. apply eq_proj1. destruct v2 as [v2 Hv2]. unfold to_Z, of_Z; simpl.
- rewrite Zdiv.Zminus_mod_idemp_l.
- ring_simplify (Z.of_nat v2 + 1 - 1). rewrite Z.mod_small, Nat2Z.id; lia.
- + exfalso. match goal with H : _ = _ |- _ => rename H into Heq end.
- apply (f_equal to_Z)in Heq. rewrite Z2Z in Heq. destruct v2 as [v2 ?].
- unfold to_Z, of_Z in Heq. simpl in Heq. symmetry in Heq. revert Heq.
- rewrite <- (Z.mod_small (Z.of_nat v2) (Z.of_nat ring_size)) at 2; try lia; [].
- apply Zadd_small_mod_non_conf. lia.
- + exfalso. match goal with H : _ = _ |- _ => rename H into Heq end.
- apply (f_equal to_Z) in Heq. revert Heq.
- rewrite 2 Z2Z. replace (to_Z v + 1) with (to_Z v - 1 + 2) by ring.
- apply Zadd_small_mod_non_conf. lia.
- + exfalso. match goal with H : _ = _ |- _ => rename H into Heq end.
- apply (f_equal to_Z) in Heq. revert Heq.
- rewrite Z2Z. rewrite <- (Z.mod_small _ _ (to_Z_small v)) at 2.
- apply Zadd_small_mod_non_conf. lia.
- + exfalso. match goal with H : _ = _ |- _ => rename H into Heq end.
- apply (f_equal to_Z) in Heq. revert Heq.
- rewrite Z2Z. rewrite <- (Z.mod_small _ _ (to_Z_small v)) at 1.
- replace (to_Z v) with (to_Z v - 1 + 1) at 1 by ring.
- apply Zadd_small_mod_non_conf. lia.
- + match goal with H : _ = of_Z (_ + 1) -> False |- _ => apply H end.
- apply to_Z_injective. rewrite 2 Z2Z, Zdiv.Zplus_mod_idemp_l.
- ring_simplify (to_Z v - 1 + 1). symmetry. apply Z.mod_small, to_Z_small.
-Defined.
+ tgt := λ e, move_along (fst e) (snd e);
+ find_edge := find_edge_subterm;
+ find_edge_Some := find_edge_subproof |}.
-(** If we do not care about threshold values, we just take 1/2 everywhere. *)
-Definition nothresholdRing : FiniteGraph ring_size (ring_edge) :=
- Ring (fun _ => 1/2)%R
- ltac:(abstract (intro; lra))
- (fun _ _ _ => eq_refl).
-End Ring.
+Global Instance Ring_isomorphism_Setoid :
+ Setoid (isomorphism Ring) := isomorphism_Setoid.
+
+Global Instance Ring_isomorphism_Inverse : Inverse (isomorphism Ring)
+ := @IsoInverse _ _ Ring.
+Global Instance Ring_isomorphism_Composition
+ : Composition (isomorphism Ring) := @IsoComposition _ _ Ring.
(** ** Ring operations **)
-Section RingTranslation.
-Context {RR : RingSpec}.
-Local Instance localRing : FiniteGraph ring_size ring_edge := nothresholdRing.
-Notation ring_node := (finite_node ring_size).
-
-(** *** Translation along a ring **)
-
-(* TODO: generalize the definition of translation to thresholds. *)
-Lemma bij_trans_V_proof : forall c x y,
- of_Z (to_Z x - c) == y <-> of_Z (to_Z y + c) == x.
-Proof using .
-intros c [x ?] [y ?]. unfold of_Z, to_Z.
-split; intro Heq; apply (f_equal (@proj1_sig _ _)) in Heq;
-simpl in *; subst; apply eq_proj1; simpl;
-rewrite Z2Nat.id; auto using to_Z_sup_0.
-- rewrite Z.add_mod_idemp_l; try lia; [].
- ring_simplify (Z.of_nat x - c + c)%Z.
- rewrite Z.mod_small, Nat2Z.id; lia.
-- rewrite Zdiv.Zminus_mod_idemp_l.
- ring_simplify (Z.of_nat y + c - c)%Z.
- rewrite Z.mod_small, Nat2Z.id; lia.
-Qed.
-
-Definition bij_trans_V (c : Z) : @Bijection.bijection ring_node (@V_Setoid _ _ localRing) := {|
- Bijection.section := fun x => of_Z (to_Z x - c);
- Bijection.retraction := fun x => of_Z (to_Z x + c);
- Bijection.Inversion := bij_trans_V_proof c |}.
-
-Definition bij_trans_E (c : Z) : @Bijection.bijection ring_edge (@E_Setoid _ _ localRing).
-refine {|
- Bijection.section := fun x => (of_Z (to_Z (fst x) - c), snd x);
- Bijection.retraction := fun x => (of_Z (to_Z (fst x) + c), snd x) |}.
-Proof.
-+ abstract (intros ? ? Heq; hnf in *; simpl; destruct Heq as [Heq ?]; now rewrite Heq).
-+ abstract (intros [x dx] [y dy]; split; intros [Hxy Hd];
- split; try (now apply bij_trans_V_proof); [|];
- destruct (Nat.eq_dec ring_size 2);
- solve [simpl in *; destruct dx, dy; tauto | symmetry; apply Hd]).
+Lemma srcE : ∀ e : ring_edge, src e = fst e.
+Proof using . reflexivity. Qed.
+
+Lemma tgtE : ∀ e : ring_edge, tgt e = move_along (fst e) (snd e).
+Proof using . reflexivity. Qed.
+
+Lemma find_edgeE : ∀ v1 v2 : fin n,
+ find_edge v1 v2 = match (nod2Odir (subf v2 v1)) with
+ | Some d1 => Some (v1, d1)
+ | None => None
+ end.
+Proof using . reflexivity. Qed.
+
+Lemma find_edge_move_along : ∀ (v : fin n) (d : direction),
+ find_edge v (move_along v d) = Some (v, d).
+Proof using .
+ intros. rewrite <- opt_Setoid_eq. setoid_rewrite find_edge_Some.
+ split. all: reflexivity.
+Qed.
+
+Definition trans (v : fin n) : isomorphism Ring.
+Proof using .
+ refine {|
+ iso_V := asbf vâ»Â¹;
+ iso_E := prod_eq_bij (asbf vâ»Â¹) Bijection.id |}.
+ abstract (intros; split; [reflexivity | apply subf_move_along']).
Defined.
+Global Opaque trans.
-Definition trans (c : Z) : isomorphism localRing.
-refine {|
- iso_V := bij_trans_V c;
- iso_E := bij_trans_E c;
- iso_T := @Bijection.id _ R_Setoid |}.
-Proof.
-* (* iso_morphism *)
- intro e. split.
- + simpl. reflexivity.
- + apply to_Z_injective.
- unfold tgt. simpl. unfold move_along.
- destruct (snd e) eqn:Hsnd; repeat rewrite Z2Z.
- - repeat rewrite ?Zdiv.Zplus_mod_idemp_l, ?Zdiv.Zminus_mod_idemp_l. f_equal. ring.
- - rewrite 2 Zdiv.Zminus_mod_idemp_l. f_equal. ring.
- - reflexivity.
-* (* iso_threshold *)
- intro. simpl. reflexivity.
-* (* iso_incr *)
- intro. simpl. tauto.
-* (* iso_bound_T *)
- intro. simpl. tauto.
-Defined. (* TODO: abstract the proofs *)
-
-Instance trans_compat : Proper (equiv ==> @equiv _ isomorphism_Setoid) trans.
-Proof using .
-intros c1 c2 Hc. simpl in *. subst.
-repeat split; try reflexivity; [].
-repeat destruct_match; tauto.
-Qed.
-
-Lemma trans_origin : @equiv _ isomorphism_Setoid (trans 0) Isomorphism.id.
-Proof using .
-split; [| split; [| reflexivity]].
-+ intro x. apply eq_proj1. cbn -[of_Z]. now rewrite Z.sub_0_r, V2V.
-+ intros [x d]. cbn -[equiv]. now rewrite Z.sub_0_r, V2V.
-Qed.
-
-Lemma trans_same : forall k, Bijection.section (trans (to_Z k)) k == of_Z 0.
-Proof using . intro k. simpl. f_equal. ring. Qed.
-
-(** *** Symmetry of a ring w.r.t. a point [c] **)
-
-Definition swap_direction dir :=
- match dir with
- | Forward => Backward
- | Backward => Forward
- | SelfLoop => SelfLoop
- end.
+Definition trans_compat : Proper (equiv ==> equiv) trans := _.
+
+Lemma transvE : ∀ v : fin n, trans v = asbf vâ»Â¹ :> bijection (fin n).
+Proof using . reflexivity. Qed.
+
+Lemma transvVE : ∀ v : fin n, trans vâ»Â¹ == asbf v :> bijection (fin n).
+Proof using . intros. rewrite <- (Bijection.inv_inv (asbf v)). reflexivity. Qed.
+
+Lemma transeE :
+ ∀ v : fin n, iso_E (trans v) = prod_eq_bij (asbf vâ»Â¹) Bijection.id.
+Proof using . reflexivity. Qed.
+
+Lemma transeVE :
+ ∀ v : fin n, iso_E (trans vâ»Â¹) == prod_eq_bij (asbf v) Bijection.id.
+Proof using .
+ intros. rewrite <- (Bijection.inv_inv (asbf v)),
+ <- Bijection.id_inv, <- prod_eq_bij_inv. reflexivity.
+Qed.
+
+Lemma trans0 : trans fin0 == id.
+Proof using .
+ split. rewrite transvE. 2: rewrite transeE. all: rewrite asbf0,
+ Bijection.id_inv. reflexivity. apply prod_eq_bij_id.
+Qed.
-Lemma bij_sym_V_proof : forall c x y, of_Z (c - to_Z x) == y <-> of_Z (c - to_Z y) == x.
-Proof using .
-intros c x y. simpl. split; intro; subst; rewrite Z2Z; apply eq_proj1;
-unfold of_Z; simpl proj1_sig; rewrite Zdiv.Zminus_mod_idemp_r;
-match goal with x : ring_node |- _ =>
- ring_simplify (c - (c - to_Z x))%Z; destruct x as [m Hm] end;
-unfold to_Z; simpl; rewrite Z.mod_small, Nat2Z.id; lia.
-Qed.
-
-Definition bij_sym_V (c : Z) : @Bijection.bijection ring_node (@V_Setoid _ _ localRing) := {|
- Bijection.section := fun x => of_Z (c - to_Z x);
- Bijection.retraction := fun x => of_Z (c - to_Z x);
- Bijection.Inversion := bij_sym_V_proof c |}.
-
-Definition bij_sym_E (c : Z) : @Bijection.bijection ring_edge (@E_Setoid _ _ localRing).
-refine {|
- Bijection.section := fun x => (of_Z (c - to_Z (fst x)), swap_direction (snd x));
- Bijection.retraction := fun x => (of_Z (c - to_Z (fst x)), swap_direction (snd x)) |}.
-Proof.
-+ abstract (intros x y [Heq ?]; hnf in *; simpl; rewrite Heq;
- destruct (Nat.eq_dec ring_size 2), (snd x), (snd y); simpl in *; tauto || discriminate).
-+ abstract (intros [x dx] [y dy]; split; intros [Hxy Hd];
- split; try (now apply bij_sym_V_proof); [|]; simpl in *;
- destruct (Nat.eq_dec ring_size 2), dx, dy; simpl in *; tauto || discriminate).
+Lemma transI : ∀ v1 v2 : fin n, trans v1 == trans v2 → v1 = v2.
+Proof using . intros * H. apply subfI with (f1:=v1), H. Qed.
+
+Lemma transVI : ∀ v1 v2 : fin n, (trans v1)â»Â¹ == (trans v2)â»Â¹ → v1 = v2.
+Proof using . intros * H. apply addfI with (f1:=v1), H. Qed.
+
+Lemma transAC :
+ ∀ v1 v2 : fin n, trans v2 ∘ (trans v1) == trans v1 ∘ (trans v2).
+Proof using .
+ intros. split. rewrite 2 (compvE (trans _)), 2 transvE. apply asbfVAC.
+ rewrite 2 (compeE (trans _)), 2 transeE. setoid_rewrite prod_eq_bij_comp.
+ rewrite (asbfVAC v2). reflexivity.
+Qed.
+
+Lemma transVAC : ∀ v1 v2 : fin n,
+ (trans v2)â»Â¹ ∘ (trans v1)â»Â¹ == (trans v1)â»Â¹ ∘ (trans v2)â»Â¹.
+Proof using .
+ intros. split. rewrite 2 (compvE (trans _â»Â¹)), 2 transvVE. apply asbfAC.
+ rewrite 2 (compeE (trans _â»Â¹)), 2 transeVE. setoid_rewrite prod_eq_bij_comp.
+ rewrite (asbfAC v2). reflexivity.
+Qed.
+
+Lemma transCV : ∀ v1 v2 : fin n,
+ trans v1 ∘ (trans v2)â»Â¹ == (trans v2)â»Â¹ ∘ (trans v1).
+Proof using .
+ intros. split. rewrite (compvE (trans _)), (compvE (trans _â»Â¹)), transvE,
+ transvVE. symmetry. apply asbfCV. rewrite (compeE (trans _)),
+ (compeE (trans _â»Â¹)), transeE, transeVE. setoid_rewrite prod_eq_bij_comp.
+ rewrite (asbfCV v2). reflexivity.
+Qed.
+
+Lemma transA :
+ ∀ v1 v2 : fin n, trans (trans v1 v2) == (trans v1â»Â¹) ∘ (trans v2).
+Proof using .
+ intros. split. rewrite (compvE (trans _â»Â¹)), 3 transvE, transvVE.
+ apply asbfVAV. rewrite (compeE (trans _â»Â¹)), transvE, 2 transeE, transeVE.
+ setoid_rewrite prod_eq_bij_comp. rewrite asbfVAV, Bijection.id_comp_l.
+ reflexivity.
+Qed.
+
+Lemma transAV :
+ ∀ v1 v2 : fin n, trans ((trans v1)â»Â¹ v2) == (trans v1) ∘ (trans v2).
+Proof using .
+ intros. split. rewrite (compvE (trans _)), 3 transvE, transvVE.
+ apply asbfVA. rewrite (compeE (trans _)), transvVE, 3 transeE.
+ setoid_rewrite prod_eq_bij_comp. rewrite asbfVA, Bijection.id_comp_l.
+ reflexivity.
+Qed.
+
+Lemma transVA :
+ ∀ v1 v2 : fin n, trans (trans v1 v2)â»Â¹ == (trans v1) ∘ (trans v2â»Â¹).
+Proof using .
+ intros. split. rewrite (compvE (trans _)), transvE, 2 transvVE.
+ apply asbfAV. rewrite (compeE (trans _)), transvE, transeE, 2 transeVE.
+ setoid_rewrite prod_eq_bij_comp. rewrite asbfAV, Bijection.id_comp_l.
+ reflexivity.
+Qed.
+
+Lemma transVAV :
+ ∀ v1 v2 : fin n, trans ((trans v1)â»Â¹ v2)â»Â¹ == (trans v1â»Â¹) ∘ (trans v2â»Â¹).
+Proof using .
+ intros. split. rewrite (compvE (trans _â»Â¹)), 3 transvVE.
+ apply asbfA. rewrite (compeE (trans _â»Â¹)), transvVE, 3 transeVE.
+ setoid_rewrite prod_eq_bij_comp.
+ rewrite asbfA, Bijection.id_comp_l. reflexivity.
+Qed.
+
+Lemma move_along_trans : ∀ (v1 v2 : fin n) (d : direction),
+ move_along (trans v1 v2) d == trans v1 (move_along v2 d).
+Proof using .
+ intros. rewrite transvE, (asbfVE v1). symmetry. apply subf_move_along'.
+Qed.
+
+Lemma trans_inj : Preliminary.injective equiv equiv trans.
+Proof using .
+ intros v1 v2 [H _]. eapply addfI. rewrite (addfC _ v2).
+ apply inverse_compat in H. rewrite (transvVE v1), (transvVE v2) in H.
+ specialize (H v2). rewrite (asbfE v1), (asbfE v2) in H. apply H.
+Qed.
+
+Lemma transs : ∀ v : fin n, trans v v = fin0.
+Proof using . intros. rewrite transvE. apply asbfVf. Qed.
+
+Definition sym (v : fin n) : isomorphism Ring.
+Proof using .
+ refine {|
+ iso_V := sybf v;
+ iso_E := prod_eq_bij (sybf v) swbd |}.
+ (* iso_morphism *)
+ abstract (intros; split; [reflexivity | apply symf_move_along]).
Defined.
+Global Opaque sym.
+
+Definition sym_compat : Proper (equiv ==> equiv) sym := _.
+
+Lemma symvE : ∀ v : fin n, sym v = sybf v :> bijection (fin n).
+Proof using . reflexivity. Qed.
-Definition sym (c : Z) : isomorphism localRing.
-refine {|
- iso_V := bij_sym_V c;
- iso_E := bij_sym_E c;
- iso_T := @Bijection.id _ R_Setoid |}.
-Proof.
-* (* iso_morphism *)
- intro e. split.
- + simpl. reflexivity.
- + apply eq_proj1.
- unfold tgt. simpl. unfold move_along.
- destruct (snd e) eqn:Hsnd; simpl; repeat rewrite Z2Z.
- - rewrite Zdiv.Zminus_mod_idemp_r, Zdiv.Zminus_mod_idemp_l. do 2 f_equal. ring.
- - rewrite Zdiv.Zplus_mod_idemp_l, Zdiv.Zminus_mod_idemp_r. do 2 f_equal. ring.
- - reflexivity.
-* (* iso_threshold *)
- intro. simpl. reflexivity.
-* (* iso_incr *)
- intro. simpl. tauto.
-* (* iso_bound_T *)
- intro. simpl. tauto.
-Defined. (* TODO: abstract the proofs *)
-
-Instance sym_compat : Proper (equiv ==> @equiv _ isomorphism_Setoid) sym.
-Proof using .
-intros c1 c2 Hc. simpl in *. subst.
-repeat split; try reflexivity; [].
-repeat destruct_match; tauto.
-Qed.
-
-Lemma sym_involutive : forall c,
- @equiv _ isomorphism_Setoid (@compose _ _ IsoComposition (sym c) (sym c)) Isomorphism.id.
-Proof using .
-intro c. split; [| split; [| simpl; reflexivity]].
-+ intro x. apply eq_proj1. cbn -[of_Z]. rewrite Z2Z. unfold of_Z. simpl.
- rewrite Zdiv.Zminus_mod_idemp_r. ring_simplify (c - (c - to_Z x))%Z.
- unfold to_Z. rewrite Z.mod_small, Nat2Z.id; trivial; []. assert (Hx := proj2_sig x).
- simpl in Hx.
- lia.
-+ intro x. split.
- - (* TODO: same proof as above, factor it? *)
- apply eq_proj1. cbn -[of_Z]. rewrite Z2Z. unfold of_Z. simpl.
- rewrite Zdiv.Zminus_mod_idemp_r. ring_simplify (c - (c - to_Z (fst x)))%Z.
- unfold to_Z. rewrite Z.mod_small, Nat2Z.id; trivial; [].
- assert (Hx := proj2_sig (fst x)).
- simpl in Hx.
- lia.
- - simpl. destruct (snd x); simpl; now destruct_match.
-Qed.
-
-End RingTranslation.
+Lemma symeE : ∀ v : fin n, iso_E (sym v) = prod_eq_bij (sybf v) swbd.
+Proof using . reflexivity. Qed.
+
+Lemma symvVE : ∀ v : fin n, sym vâ»Â¹ == sybf v :> bijection (fin n).
+Proof using . intros v1 v2. rewrite <- (sybfV v1). reflexivity. Qed.
+
+Lemma symeVE : ∀ v : fin n, iso_E (sym vâ»Â¹) == prod_eq_bij (sybf v) swbd.
+Proof using .
+ intros. rewrite <- sybfV, <- swbdV, <- prod_eq_bij_inv. reflexivity.
+Qed.
+
+Lemma symK : ∀ v : fin n, (sym v) ∘ (sym v) == id.
+Proof using .
+ intros. split. rewrite (compvE (sym v)), symvE. apply sybfK.
+ rewrite (compeE (sym v)), symeE. setoid_rewrite prod_eq_bij_comp.
+ rewrite (sybfK v), swbdK, prod_eq_bij_id. reflexivity.
+Qed.
+
+Lemma move_along_sym : ∀ (v1 v2 : fin n) (d : direction),
+ move_along (sym v1 v2) d = sym v1 (move_along v2 (swap_direction d)).
+Proof using . intros. rewrite symvE, (sybfE v1). apply move_along_symf. Qed.
+
+Lemma symm : ∀ v : fin n, sym v v = v.
+Proof using . intros. rewrite symvE. apply sybff. Qed.
+
+End Ring.
diff --git a/Spaces/ThresholdIsomorphism.v b/Spaces/ThresholdIsomorphism.v
new file mode 100644
index 0000000000000000000000000000000000000000..8011d799cc64af5a841c05f4700b8ebf5dc92a6f
--- /dev/null
+++ b/Spaces/ThresholdIsomorphism.v
@@ -0,0 +1,100 @@
+Require Import Utf8 SetoidDec Rbase Rbasic_fun Psatz.
+From Pactole Require Import Util.Coqlib Util.Bijection Util.Ratio.
+From Pactole Require Import Spaces.Graph Spaces.Isomorphism.
+Set Implicit Arguments.
+
+Section ThresholdIsomorphism.
+
+Context {V E : Type}.
+Context {G : ThresholdGraph V E}.
+
+Record threshold_isomorphism := {
+ iso_VE :> isomorphism G;
+ iso_T : bijection strict_ratio;
+ iso_threshold : ∀ e : E, iso_T (threshold e) == threshold (iso_E iso_VE e) :> strict_ratio;
+ iso_incr : ∀ a b : strict_ratio, (a < b)%R -> (iso_T a < iso_T b)%R }.
+
+Global Instance threshold_isomorphism_Setoid : Setoid threshold_isomorphism.
+Proof using .
+ simple refine {|
+ equiv := λ iso1 iso2, iso1.(iso_VE) == iso2.(iso_VE)
+ /\ iso1.(iso_T) == iso2.(iso_T) |}; autoclass. split.
+ + intro f. now repeat split.
+ + intros f g Hfg; destruct Hfg as [HVE HT]. split; now symmetry.
+ + intros f g h Hfg Hgh. destruct Hfg as [? ?], Hgh as [? ?].
+ split; etransitivity; eauto.
+Defined.
+
+Instance iso_T_compat : Proper (equiv ==> equiv) iso_T.
+Proof using . intros ? ? Heq ?. now apply Heq. Qed.
+
+Definition id : threshold_isomorphism.
+Proof using .
+ refine {| iso_VE := id;
+ iso_T := Bijection.id |}.
+ + now intros.
+ + now intros.
+Defined.
+
+Definition comp (f g : threshold_isomorphism) : threshold_isomorphism.
+Proof using .
+ refine {|
+ iso_VE := compose f.(iso_VE) g.(iso_VE);
+ iso_T := compose f.(iso_T) g.(iso_T) |}.
+ + intro. simpl. now rewrite 2 iso_threshold.
+ + intros. simpl. now do 2 apply iso_incr.
+Defined.
+
+Global Instance TIsoComposition : Composition threshold_isomorphism.
+Proof using .
+ refine {| compose := comp |}.
+ intros f1 f2 Hf g1 g2 Hg. split. all: apply compose_compat.
+ 3,4: f_equiv. 1,3: apply Hf. all: apply Hg.
+Defined.
+
+Lemma compose_assoc : ∀ f g h, f ∘ (g ∘ h) == (f ∘ g) ∘ h.
+Proof using . intros f g h; repeat split; simpl; reflexivity. Qed.
+
+Definition inv (tiso : threshold_isomorphism) : threshold_isomorphism.
+Proof using .
+ refine {| iso_VE := inverse tiso.(iso_VE);
+ iso_T := inverse tiso.(iso_T) |}.
+ + intros e. cbn-[equiv]. rewrite <- Inversion, iso_threshold,
+ section_retraction. reflexivity.
+ + intros a b Hab. apply Rnot_le_lt. intros [Hd | Hd].
+ all: apply (Rlt_not_le b a Hab). left. erewrite <- (section_retraction _ b),
+ <- (section_retraction _ a). apply iso_incr, Hd. right.
+ apply proj_ratio_compat, proj_strict_ratio_compat,
+ (injective (iso_T tiso â»Â¹)), proj_strict_ratio_inj, proj_ratio_inj, Hd.
+Defined.
+
+Global Instance TIsoInverse : Inverse threshold_isomorphism.
+Proof using .
+ refine {| inverse := inv |}.
+ intros f g [? ?]. split. all: apply inverse_compat. all: assumption.
+Defined.
+
+Lemma id_inv : idâ»Â¹ == id.
+Proof using . split. apply id_inv. setoid_rewrite Bijection.id_inv. reflexivity. Qed.
+
+Lemma id_comp_l : ∀ tiso : threshold_isomorphism, id ∘ tiso == tiso.
+Proof using. intros. split. apply id_comp_l. setoid_rewrite Bijection.id_comp_l. reflexivity. Qed.
+
+Lemma id_comp_r : ∀ tiso : threshold_isomorphism, tiso ∘ id == tiso.
+Proof using. intros. split. apply id_comp_r. setoid_rewrite Bijection.id_comp_r. reflexivity. Qed.
+
+Lemma inv_inv : ∀ tiso : threshold_isomorphism, tisoâ»Â¹â»Â¹ == tiso.
+Proof using . intros. split. apply inv_inv. setoid_rewrite Bijection.inv_inv. reflexivity. Qed.
+
+Lemma compose_inverse_l : ∀ tiso : threshold_isomorphism, tiso â»Â¹ ∘ tiso == id.
+Proof using . intro. split. apply compose_inverse_l. setoid_rewrite Bijection.compose_inverse_l. reflexivity. Qed.
+
+Lemma compose_inverse_r : ∀ tiso : threshold_isomorphism, tiso ∘ (tiso â»Â¹) == id.
+Proof using . intro. split. apply compose_inverse_r. setoid_rewrite Bijection.compose_inverse_r. reflexivity. Qed.
+
+Lemma inverse_compose : ∀ f g : threshold_isomorphism, (f ∘ g) â»Â¹ == (g â»Â¹) ∘ (f â»Â¹).
+Proof using . intros f g. split. apply inverse_compose. setoid_rewrite Bijection.inverse_compose. reflexivity. Qed.
+
+End ThresholdIsomorphism.
+
+Arguments threshold_isomorphism {V} {E} G.
diff --git a/Util/Bijection.v b/Util/Bijection.v
index 00818bc0c72950512ccf3d3113f7d9698c1282d9..c0a8672c465f0bae90aa288fa8cfe8253ad0f085 100644
--- a/Util/Bijection.v
+++ b/Util/Bijection.v
@@ -22,28 +22,33 @@ Set Implicit Arguments.
(** Bijections on a type [T] with an equivalence relation [eqT] *)
Section Bijections.
-Context (T : Type).
+Context {T : Type}.
Context {HeqT : Setoid T}.
Record bijection := {
- section :> T → T;
+ #[export] section :> T → T;
retraction : T → T;
section_compat : Proper (equiv ==> equiv) section;
Inversion : ∀ x y, section x == y ↔ retraction y == x}.
-Global Existing Instance section_compat.
+#[export]Existing Instance section_compat.
-Global Instance bij_Setoid : Setoid bijection.
-simple refine {| equiv := fun f g => forall x, f.(section) x == g x |}; auto; [].
+#[export]Instance bij_Setoid : Setoid bijection.
+simple refine {| equiv := λ f g, ∀ x, f.(section) x == g x |}; auto; [].
Proof. split.
+ repeat intro. reflexivity.
+ repeat intro. now symmetry.
+ repeat intro. etransitivity; eauto.
Defined.
-Global Instance section_full_compat : Proper (equiv ==> (equiv ==> equiv)) section.
+(* Use fun_Setoid directly in the definition of bij_Setoid? *)
+#[export]Instance bij_Setoid_eq_compat : Proper ((@equiv bijection bij_Setoid)
+ ==> (@equiv (T -> T) (fun_Setoid T HeqT))) section.
+Proof using . intros ?? H. apply H. Qed.
+
+#[export]Instance section_full_compat : Proper (equiv ==> (equiv ==> equiv)) section.
Proof using . intros f g Hfg x y Hxy. rewrite Hxy. now apply Hfg. Qed.
-Global Instance retraction_compat : Proper (equiv ==> (equiv ==> equiv)) retraction.
+#[export]Instance retraction_compat : Proper (equiv ==> (equiv ==> equiv)) retraction.
Proof using . intros f g Hfg x y Hxy. now rewrite <- f.(Inversion), Hxy, Hfg, g.(Inversion). Qed.
(** The identity bijection *)
@@ -62,14 +67,18 @@ Proof.
+ abstract (intros x y; now rewrite f.(Inversion), <- g.(Inversion)).
Defined.
-Global Instance BijectionComposition : Composition bijection.
+#[export]Instance BijectionComposition : Composition bijection.
refine {| compose := comp |}.
Proof.
intros f1 f2 Hf g1 g2 Hg x. cbn -[equiv].
rewrite (Hf (g1 x)). f_equiv. apply Hg.
Defined.
+
+Lemma compE : ∀ f g : bijection, f ∘ g = (λ t, f (g t)) :> (T -> T).
+Proof using . reflexivity. Qed.
+
(*
-Global Instance compose_compat : Proper (equiv ==> equiv ==> equiv) compose.
+#[export]Instance compose_compat : Proper (equiv ==> equiv ==> equiv) compose.
Proof.
intros f1 f2 Hf g1 g2 Hg x. cbn -[equiv].
rewrite (Hf (g1 x)). f_equiv. apply Hg.
@@ -84,11 +93,24 @@ refine {| section := bij.(retraction);
retraction := bij.(section) |}.
Proof. abstract (intros; rewrite bij.(Inversion); reflexivity). Defined.
-Global Instance BijectionInverse : Inverse bijection.
+#[export]Instance BijectionInverse : Inverse bijection.
refine {| inverse := inv |}.
Proof. repeat intro. simpl. now f_equiv. Defined.
+
+Lemma id_inv : idâ»Â¹ == id.
+Proof using . intros t. reflexivity. Qed.
+
+Lemma id_comp_l : ∀ b : bijection, id ∘ b == b.
+Proof using. intros. cbn. reflexivity. Qed.
+
+Lemma id_comp_r : ∀ b : bijection, b ∘ id == b.
+Proof using. intros. cbn. reflexivity. Qed.
+
+Lemma inv_inv : ∀ b : bijection, bâ»Â¹â»Â¹ == b.
+Proof using . intros. cbn. reflexivity. Qed.
+
(*
-Global Instance inverse_compat : Proper (equiv ==> equiv) inverse.
+#[export]Instance inverse_compat : Proper (equiv ==> equiv) inverse.
Proof. repeat intro. simpl. now f_equiv. Qed.
*)
Lemma retraction_section : forall (bij : bijection) x, bij.(retraction) (bij.(section) x) == x.
@@ -106,6 +128,18 @@ Proof using . repeat intro. simpl. now rewrite section_retraction. Qed.
Lemma inverse_compose : forall f g : bijection, (f ∘ g)â»Â¹ == (g â»Â¹) ∘ (f â»Â¹).
Proof using . repeat intro. reflexivity. Qed.
+Definition cancel_bijection (f g : T -> T)
+ (fP : Proper (equiv ==> equiv) f) (f_inj : injective equiv equiv f)
+ (fK : ∀ t, g (f t) == t) (gK : ∀ t, f (g t) == t) : bijection.
+Proof using .
+ refine {|
+ section := f;
+ retraction := g;
+ section_compat := fP |}.
+ abstract (intros t1 t2; split; intros H; [rewrite <- (gK t2) in H;
+ apply f_inj in H; rewrite H; reflexivity | rewrite <- H; apply gK]).
+Defined.
+
(** Bijections are in particular injective. *)
Lemma injective : forall bij : bijection, injective equiv equiv bij.
Proof using . intros bij x y Heq. now rewrite <- (retraction_section bij x), Heq, retraction_section. Qed.
@@ -115,3 +149,109 @@ End Bijections.
Arguments bijection T {_}.
Arguments section {_} {_} !_ x.
Arguments retraction {_} {_} !_ x.
+
+Section prod_bij.
+
+Context {A B : Type} (SA : Setoid A) (SB : Setoid B).
+
+Definition prod_bij (BA : bijection A) (BB : bijection B) : bijection (A * B).
+Proof using .
+ refine {|
+ section := λ p, (BA (fst p), BB (snd p));
+ retraction := λ p, (BAâ»Â¹ (fst p), BBâ»Â¹ (snd p)) |}.
+ abstract (intros ?? H; rewrite H; reflexivity).
+ abstract (intros; split; intros H; rewrite <- H; split;
+ apply Inversion; reflexivity).
+Defined.
+
+Lemma prod_bijE : ∀ (BA : bijection A) (BB : bijection B),
+ prod_bij BA BB = (λ p : A * B, (BA (fst p), BB (snd p))) :> (A * B -> A * B).
+Proof using . reflexivity. Qed.
+
+Lemma prod_bijVE : ∀ (BA : bijection A) (BB : bijection B),
+ prod_bij BA BBâ»Â¹ = (λ p, (BAâ»Â¹ (fst p), BBâ»Â¹ (snd p))) :> (A * B -> A * B).
+Proof using . reflexivity. Qed.
+
+#[export]Instance prod_bij_compat : Proper (equiv ==> equiv ==> equiv) prod_bij.
+Proof using .
+ intros * BA1 BA2 HA BB1 BB2 HB p. rewrite 2 prod_bijE. split.
+ rewrite HA. reflexivity. rewrite HB. reflexivity.
+Qed.
+
+Lemma prod_bij_id : prod_bij (@id A SA) (@id B SB) == id.
+Proof using . intros * p. rewrite prod_bijE. split. all: reflexivity. Qed.
+
+Lemma prod_bij_comp : ∀ (BA1 BA2 : bijection A) (BB1 BB2 : bijection B),
+ prod_bij BA1 BB1 ∘ (prod_bij BA2 BB2) == prod_bij (BA1 ∘ BA2) (BB1 ∘ BB2).
+Proof using . intros * p. rewrite compE, 3 prod_bijE, 2 compE. reflexivity. Qed.
+
+Lemma prod_bij_inv : ∀ (BA : bijection A) (BB : bijection B),
+ (prod_bij BA BB)â»Â¹ == prod_bij (BAâ»Â¹) (BBâ»Â¹).
+Proof using . intros * p. rewrite prod_bijVE, prod_bijE. reflexivity. Qed.
+
+Definition prod_eq_bij (BA : @bijection A (eq_setoid A))
+ (BB : @bijection B (eq_setoid B)) : @bijection (A * B) (eq_setoid (A * B)).
+Proof using .
+ refine {|
+ section := λ p, (BA (fst p), BB (snd p));
+ retraction := λ p, (BAâ»Â¹ (fst p), BBâ»Â¹ (snd p)) |}.
+ abstract (intros; split; cbn; intros H; rewrite <- H, <- pair_eqE;
+ cbn[fst snd]; [rewrite 2 retraction_section | rewrite 2 section_retraction];
+ split; reflexivity).
+Defined.
+
+Lemma prod_eq_bijE : ∀ (BA : bijection A) (BB : bijection B), prod_eq_bij BA BB
+ = (λ p : A * B, (BA (fst p), BB (snd p))) :> (A * B -> A * B).
+Proof using . reflexivity. Qed.
+
+Lemma prod_eq_bijVE : ∀ (BA : bijection A) (BB : bijection B),
+ prod_eq_bij BA BBâ»Â¹ = (λ p, (BAâ»Â¹ (fst p), BBâ»Â¹ (snd p))) :> (A * B -> A * B).
+Proof using . reflexivity. Qed.
+
+#[export]Instance prod_eq_bij_compat :
+ Proper (equiv ==> equiv ==> equiv) prod_eq_bij.
+Proof using .
+ cbn. intros * BA1 BA2 HA BB1 BB2 HB p. rewrite 2 prod_eq_bijE, <- pair_eqE.
+ split. rewrite HA. reflexivity. rewrite HB. reflexivity.
+Qed.
+
+Lemma prod_eq_bij_id : prod_eq_bij id id == id.
+Proof using .
+ intros * p. rewrite prod_eq_bijE. apply pair_eqE. split. all: reflexivity.
+Qed.
+
+Lemma prod_eq_bij_comp : ∀ (BA1 BA2 : bijection A) (BB1 BB2 : bijection B),
+ prod_eq_bij BA1 BB1 ∘ (prod_eq_bij BA2 BB2)
+ == prod_eq_bij (BA1 ∘ BA2) (BB1 ∘ BB2).
+Proof using .
+ intros * p. rewrite compE, 3 prod_eq_bijE, 2 compE. reflexivity.
+Qed.
+
+Lemma prod_eq_bij_inv : ∀ (BA : bijection A) (BB : bijection B),
+ (prod_eq_bij BA BB)â»Â¹ == prod_eq_bij (BAâ»Â¹) (BBâ»Â¹).
+Proof using . intros * p. rewrite prod_eq_bijVE, prod_eq_bijE. reflexivity. Qed.
+
+End prod_bij.
+
+Section equiv_bij.
+
+Context {T : Type} [S1 S2 : Setoid T].
+Context (H : ∀ t1 t2 : T, @equiv T S1 t1 t2 <-> @equiv T S2 t1 t2).
+
+Definition equiv_bij : @bijection T S1 -> @bijection T S2.
+Proof using H.
+ intros [s r c p]. refine {| section := s; retraction := r |}.
+ abstract (intros ?? Heq; apply H, c, H, Heq).
+ abstract (intros; rewrite <-2 H; apply p).
+Defined.
+
+Lemma equiv_bijE : ∀ b : @bijection T S1, equiv_bij b = b :> (T -> T).
+Proof using . intros []. reflexivity. Qed.
+
+Lemma equiv_bijVE : ∀ b : @bijection T S1, equiv_bij bâ»Â¹ = bâ»Â¹ :> (T -> T).
+Proof using . intros []. reflexivity. Qed.
+
+Lemma equiv_bij_id : equiv_bij (@id T S1) == (@id T S2).
+Proof using . intros t. rewrite equiv_bijE. reflexivity. Qed.
+
+End equiv_bij.
diff --git a/Util/Enum.v b/Util/Enum.v
new file mode 100644
index 0000000000000000000000000000000000000000..e7e63556348417e60a9c1baa318c320ef8573396
--- /dev/null
+++ b/Util/Enum.v
@@ -0,0 +1,203 @@
+Require Import Utf8 SetoidDec SetoidList Arith_base Lia.
+From Pactole Require Import Util.Coqlib Util.Fin.
+
+Set Implicit Arguments.
+
+(* TODO: should we add a fold operator? *)
+(* FIXME: change the equalities to use equiv and the Setoid class *)
+
+Program Fixpoint build_enum N k (Hle : k <= N) acc : list (fin N) :=
+ match k with
+ | 0 => acc
+ | S m => @build_enum N m _ (@Fin _ m _ :: acc)
+ end.
+Next Obligation.
+ lia.
+Qed.
+
+(** A list containing all elements of [fin N]. *)
+Definition enum N : list (fin N) := build_enum (Nat.le_refl N) nil.
+
+(** Specification of [enum]. *)
+Lemma In_build_enum : ∀ N k (Hle : k <= N) l x,
+ In x (build_enum Hle l) <-> In x l \/ fin2nat x < k.
+Proof using .
+ intros N k. induction k; intros Hle l x; simpl.
+ + intuition auto with *.
+ + rewrite IHk. simpl. split; intro Hin.
+ - destruct Hin as [[Hin | Hin] | Hin]; intuition; [].
+ subst. simpl. right. lia.
+ - destruct Hin as [Hin | Hin]; intuition; [].
+ assert (Hcase : fin2nat x < k \/ fin2nat x = k) by lia.
+ destruct Hcase as [Hcase | Hcase]; intuition; [].
+ subst. do 2 left. destruct x; f_equal; simpl in *. apply le_unique.
+Qed.
+
+Lemma In_enum : ∀ N x, In x (enum N) <-> fin2nat x < N.
+Proof using . intros. unfold enum. rewrite In_build_enum. simpl. intuition. Qed.
+
+(** Length of [enum]. *)
+Lemma build_enum_length : ∀ N k (Hle : k <= N) l,
+ length (build_enum Hle l) = k + length l.
+Proof using .
+ intros N k. induction k; intros Hle l; simpl.
+ + reflexivity.
+ + rewrite IHk. simpl. lia.
+Qed.
+
+Lemma enum_length : ∀ N, length (enum N) = N.
+Proof using . intro. unfold enum. now rewrite build_enum_length. Qed.
+
+(** [enum] does not contain duplicates. *)
+Lemma build_enum_NoDup : ∀ N k (Hle : k <= N) l,
+ (∀ x, In x l -> k <= fin2nat x) -> NoDup l -> NoDup (build_enum Hle l).
+Proof using .
+ intros N k. induction k; intros Hle l Hin Hl; simpl; auto; [].
+ apply IHk.
+ + intros x [Hx | Hx].
+ - now subst.
+ - apply Hin in Hx. lia.
+ + constructor; trivial; [].
+ intro Habs. apply Hin in Habs. simpl in Habs. lia.
+Qed.
+
+Lemma enum_NoDup : ∀ N, NoDup (enum N).
+Proof using .
+ intro. unfold enum.
+ apply build_enum_NoDup; simpl; intuition; constructor.
+Qed.
+
+(** [enum] is sorted in increasing order. *)
+Notation Flt := (fun x y => lt (fin2nat x) (fin2nat y)).
+
+Lemma build_enum_Sorted :
+ ∀ N k (Hle : k <= N) l, (∀ x, In x l -> k <= fin2nat x)
+ -> Sorted Flt l -> Sorted Flt (build_enum Hle l).
+Proof using .
+ intros N k. induction k; intros Hle l Hin Hl; simpl; auto; [].
+ apply IHk.
+ + intros x [Hx | Hx].
+ - now subst.
+ - apply Hin in Hx. lia.
+ + constructor; trivial; [].
+ destruct l; constructor; []. simpl. apply Hin. now left.
+Qed.
+
+Lemma enum_Sorted : ∀ N, Sorted Flt (enum N).
+Proof using .
+ intro. unfold enum.
+ apply build_enum_Sorted; simpl; intuition.
+Qed.
+
+(** Extensional equality of functions is decidable over finite domains. *)
+Lemma build_enum_app_nil : ∀ N k (Hle : k <= N) l,
+ build_enum Hle l = build_enum Hle nil ++ l.
+Proof using .
+ intros N k. induction k; intros Hle l; simpl.
+ + reflexivity.
+ + now rewrite (IHk _ (_ :: nil)), IHk, <- app_assoc.
+Qed.
+
+Theorem build_enum_eq : ∀ {A} eqA N (f g : fin N -> A) k (Hle : k <= N) l,
+ eqlistA eqA (List.map f (build_enum Hle l)) (List.map g (build_enum Hle l)) ->
+ ∀ x, fin2nat x < k -> eqA (f x) (g x).
+Proof using .
+ intros A eqA N f g k. induction k; intros Hle l Heq x Hx; simpl.
+ * destruct x; simpl in *; lia.
+ * assert (Hlt : k <= N) by lia.
+ assert (Hcase : fin2nat x < k \/ fin2nat x = k) by lia.
+ destruct Hcase as [Hcase | Hcase].
+ + apply IHk with (x := x) in Heq; auto.
+ + subst k. cbn in Heq. rewrite build_enum_app_nil, map_app, map_app in Heq.
+ destruct (eqlistA_app_split _ _ _ _ Heq) as [_ Heq'].
+ - now do 2 rewrite map_length, build_enum_length.
+ - simpl in Heq'. inv Heq'.
+ assert (Heqx : x = Fin Hle).
+ { clear. destruct x; simpl. f_equal. apply le_unique. }
+ now rewrite Heqx.
+Qed.
+
+Corollary enum_eq : ∀ {A} eqA N (f g : fin N -> A),
+ eqlistA eqA (List.map f (enum N)) (List.map g (enum N))
+ -> ∀ x, eqA (f x) (g x).
+Proof using .
+ unfold enum. intros A eqA N f g Heq x.
+ apply build_enum_eq with (x := x) in Heq; auto; []. apply fin_lt.
+Qed.
+
+(** Cutting [enum] after some number of elements. *)
+Lemma firstn_build_enum_le : ∀ N k (Hle : k <= N) l k' (Hk : k' <= N),
+ k' <= k -> firstn k' (build_enum Hle l) = @build_enum N k' Hk nil.
+Proof using .
+ intros N k. induction k; intros Hk l k' Hk' Hle.
+ * assert (k' = 0) by lia. now subst.
+ * rewrite build_enum_app_nil, firstn_app, build_enum_length.
+ replace (k' - (S k + length (@nil (fin N)))) with 0 by lia.
+ rewrite app_nil_r.
+ destruct (Nat.eq_dec k' (S k)) as [Heq | Heq].
+ + subst k'. rewrite firstn_all2.
+ - f_equal. apply le_unique.
+ - rewrite build_enum_length. simpl. lia.
+ + simpl build_enum. erewrite IHk.
+ - f_equal.
+ - lia.
+Qed.
+
+Lemma firstn_build_enum_lt : ∀ N k (Hle : k <= N) l k', k <= k' ->
+ firstn k' (build_enum Hle l) = build_enum Hle (firstn (k' - k) l).
+Proof using .
+ intros N k. induction k; intros Hle l k' Hk.
+ + now rewrite Nat.sub_0_r.
+ + rewrite build_enum_app_nil, firstn_app, build_enum_length, Nat.add_0_r.
+ rewrite firstn_all2, <- build_enum_app_nil; trivial; [].
+ rewrite build_enum_length. simpl. lia.
+Qed.
+
+Lemma firstn_enum_le : ∀ N k (Hle : k <= N),
+ firstn k (enum N) = build_enum Hle nil.
+Proof using . intros. unfold enum. now apply firstn_build_enum_le. Qed.
+
+Lemma firstn_enum_lt : ∀ N k, N <= k -> firstn k (enum N) = enum N.
+Proof using .
+ intros. unfold enum. now rewrite firstn_build_enum_lt, firstn_nil.
+Qed.
+
+Lemma firstn_enum_spec : ∀ N k x, In x (firstn k (enum N)) <-> fin2nat x < k.
+Proof using .
+ intros N k x. destruct (le_lt_dec k N) as [Hle | Hlt].
+ + rewrite (firstn_enum_le Hle), In_build_enum. simpl. intuition.
+ + rewrite (firstn_enum_lt (Nat.lt_le_incl _ _ Hlt)).
+ split; intro Hin.
+ - transitivity N; trivial; []. apply fin_lt.
+ - apply In_enum, fin_lt.
+Qed.
+
+(** Removing some number of elements from the head of [enum]. *)
+Lemma skipn_build_enum_lt : ∀ N k (Hle : k <= N) l k', k <= k' ->
+ skipn k' (build_enum Hle l) = skipn (k' - k) l.
+Proof using .
+ intros N k Hle l k' Hk'. apply app_inv_head with
+ (firstn k' (build_enum Hle l)). rewrite firstn_skipn, firstn_build_enum_lt;
+ trivial; []. rewrite (build_enum_app_nil Hle (firstn _ _)).
+ now rewrite build_enum_app_nil, <- app_assoc, firstn_skipn.
+Qed.
+
+Lemma skipn_enum_lt : ∀ N k, N <= k -> skipn k (enum N) = nil.
+Proof using .
+ intros. unfold enum. now rewrite skipn_build_enum_lt, skipn_nil.
+Qed.
+
+Lemma skipn_enum_spec :
+ ∀ N k x, In x (skipn k (enum N)) <-> k <= fin2nat x < N.
+Proof using .
+ intros N k x. split; intro Hin.
+ + assert (Hin' : ~In x (firstn k (enum N))).
+ { intro Habs. rewrite <- InA_Leibniz in *. revert x Habs Hin.
+ apply NoDupA_app_iff; autoclass; [].
+ rewrite firstn_skipn. rewrite NoDupA_Leibniz. apply enum_NoDup. }
+ rewrite firstn_enum_spec in Hin'. split; auto with zarith; [].
+ apply fin_lt.
+ + assert (Hin' : In x (enum N)) by apply In_enum, fin_lt.
+ rewrite <- (firstn_skipn k), in_app_iff, firstn_enum_spec in Hin'.
+ intuition lia.
+Qed.
diff --git a/Util/FMaps/FMapFacts.v b/Util/FMaps/FMapFacts.v
index 98db9062583feeb4917802253d3c0e0f9a5d8487..f2241b0e1e9252198e19242ed80c76c804b9b434 100644
--- a/Util/FMaps/FMapFacts.v
+++ b/Util/FMaps/FMapFacts.v
@@ -2,7 +2,7 @@ Require Import Bool.
Require Import Structures.DecidableType.
Require Import SetoidDec.
Require Import Pactole.Util.FMaps.FMapInterface.
-
+Require Import Pactole.Util.SetoidDefs.
Set Implicit Arguments.
Unset Strict Implicit.
@@ -16,6 +16,8 @@ Hint Extern 1 (Equivalence _) => constructor; congruence : core.
Hint Extern 1 (equiv ?x ?x) => reflexivity : core.
Hint Extern 2 (equiv ?y ?x) => now symmetry : core.
+(* this will become non default soon. *)
+Ltac Tauto.intuition_solver ::= auto with *.
Notation Leibniz := (@eq _) (only parsing).
@@ -28,7 +30,7 @@ Section WeakFacts.
Lemma eq_bool_alt : forall b b', b=b' <-> (b=true <-> b'=true).
Proof using .
- destruct b; destruct b'; intuition.
+ destruct b; destruct b'; clear; intuition.
Qed.
Lemma eq_option_alt : forall (elt:Type)(o o':option elt),
@@ -66,7 +68,7 @@ Section WeakFacts.
Lemma MapsTo_iff : forall m x y e, x == y ->
(MapsTo x e m <-> MapsTo y e m).
Proof using HF.
- split; apply MapsTo_1; auto using symmetry.
+ split; apply MapsTo_1 ; auto (*using symmetry stopped working/being useful in 8.20*).
Qed.
Lemma mem_in_iff : forall m x, In x m <-> mem x m = true.
@@ -95,7 +97,7 @@ Section WeakFacts.
Proof using HF.
split; intros.
rewrite eq_option_alt. intro e. rewrite <- find_mapsto_iff.
- split; intro H'; try discriminate. elim H; exists e; auto.
+ split; intro H'; try discriminate. contradiction H; exists e; auto.
intros (e,He); rewrite find_mapsto_iff,H in He; discriminate.
Qed.
@@ -374,7 +376,7 @@ Section WeakFacts.
Hint Resolve add_neq_o : map.
Lemma add_o : forall m x y e,
- find y (add x e m) = if x == y then Some e else find y m.
+ find y (add x e m) = if x =?= y then Some e else find y m.
Proof using HF.
intros; destruct (equiv_dec x y); auto with map.
Qed.
@@ -395,7 +397,7 @@ Section WeakFacts.
mem y (add x e m) = (equiv x y) || mem y m.
Proof.
intros; do 2 rewrite mem_find_b; rewrite add_o; unfold eqb.
- destruct (equiv_dec x y); simpl; auto.
+ destruct (equiv_dec x y); cbn; auto.
Qed. *)
Lemma remove_eq_o : forall m x y,
@@ -419,7 +421,7 @@ Section WeakFacts.
Hint Resolve remove_neq_o : map.
Lemma remove_o : forall m x y,
- find y (remove x m) = if x == y then None else find y m.
+ find y (remove x m) = if x =?= y then None else find y m.
Proof using HF.
intros; destruct (equiv_dec x y); auto with map.
Qed.
@@ -455,7 +457,7 @@ Section WeakFacts.
intros.
generalize (find_mapsto_iff (map f m) x) (find_mapsto_iff m x)
(fun b => map_mapsto_iff m x b f).
- destruct (find x (map f m)); destruct (find x m); simpl; auto; intros.
+ destruct (find x (map f m)); destruct (find x m); cbn; auto; intros.
rewrite <- H; rewrite H1; exists e0; rewrite H0; auto.
destruct (H e) as [_ H2].
rewrite H1 in H2.
@@ -468,7 +470,7 @@ Section WeakFacts.
mem x (map f m) = mem x m.
Proof using HF.
intros; do 2 rewrite mem_find_b; rewrite map_o.
- destruct (find x m); simpl; auto.
+ destruct (find x m); cbn; auto.
Qed.
Lemma mapi_b : forall m x (f:key->elt->elt'),
@@ -476,7 +478,7 @@ Section WeakFacts.
Proof using HF.
intros.
generalize (mem_in_iff (mapi f m) x) (mem_in_iff m x) (mapi_in_iff m x f).
- destruct (mem x (mapi f m)); destruct (mem x m); simpl; auto; intros.
+ destruct (mem x (mapi f m)); destruct (mem x m); cbn; auto; intros.
symmetry; rewrite <- H0; rewrite <- H1; rewrite H; auto.
rewrite <- H; rewrite H1; rewrite H0; auto.
Qed.
@@ -488,7 +490,7 @@ Section WeakFacts.
intros.
generalize (find_mapsto_iff (mapi f m) x) (find_mapsto_iff m x)
(fun b => mapi_mapsto_iff m x b H).
- destruct (find x (mapi f m)); destruct (find x m); simpl; auto; intros.
+ destruct (find x (mapi f m)); destruct (find x m); cbn; auto; intros.
rewrite <- H0; rewrite H2; exists e0; rewrite H1; auto.
destruct (H0 e) as [_ H3].
rewrite H2 in H3.
@@ -526,7 +528,7 @@ Section WeakFacts.
findA (eqb x) l =
findA (fun y => if eqb_dec x y then true else false) l.
Proof.
- intros; induction l; simpl.
+ intros; induction l; cbn.
reflexivity.
unfold eqb; destruct a; destruct (equiv_dec x k);
destruct (eqb_dec x k); auto; contradiction.
@@ -555,12 +557,12 @@ Section WeakFacts.
rewrite InA_alt in He.
destruct He as ((y,e'),(Ha1,Ha2)).
compute in Ha1; destruct Ha1; subst e'.
- exists (y,e); split; simpl; auto.
+ exists (y,e); split; cbn; auto.
unfold eqb; destruct (equiv_dec x y); intuition.
rewrite <- H; rewrite H0.
destruct H1 as (H1,_).
destruct H1 as ((y,e),(Ha1,Ha2)); [intuition|].
- simpl in Ha2.
+ cbn in Ha2.
unfold eqb in *; destruct (equiv_dec x y); auto; try discriminate.
exists e; rewrite InA_alt.
exists (y,e); intuition.
@@ -714,9 +716,10 @@ Section WeakFacts.
Global Instance Empty_m elt : Proper (Equal ==> iff) (@Empty key _ _ _ elt).
Proof using HF.
- unfold Empty; intros m m' Hm; intuition.
- rewrite <-Hm in H0; eauto.
- rewrite Hm in H0; eauto.
+ unfold Empty; intros m m' Hm.
+ split; repeat intro.
+ - rewrite <-Hm in H0; eapply H;eauto.
+ - rewrite Hm in H0; eapply H;eauto.
Qed.
Global Instance is_empty_m elt :
@@ -793,9 +796,9 @@ Section MoreWeakFacts.
k1 == k2 -> InA eq_key_elt (k1,e1) l -> InA eq_key (k2,e2) l.
Proof using .
intros k1 k2 e1 e2 l Hk. rewrite 2 InA_alt.
- intros ((k',e') & (Hk',He') & H); simpl in *.
+ intros ((k',e') & (Hk',He') & H); cbn in *.
exists (k',e'); split; auto.
- red; red; simpl; eauto.
+ red; red; cbn; eauto.
transitivity k1; auto; symmetry; auto.
Qed.
@@ -843,7 +846,7 @@ Section MoreWeakFacts.
rewrite elements_mapsto_iff.
rewrite InA_alt; exists a; auto. }
destruct (elements m); auto.
- elim (H0 p); simpl; auto.
+ contradiction (H0 p); cbn; auto.
+ red; intros.
rewrite elements_mapsto_iff in H0.
rewrite InA_alt in H0; destruct H0.
@@ -866,18 +869,18 @@ Section MoreWeakFacts.
NoDupA eq_key l ->
(MapsTo k e (of_list l) <-> InA eq_key_elt (k,e) l).
Proof using HF.
- induction l as [|(k',e') l IH]; simpl; intros k e Hnodup.
+ induction l as [|(k',e') l IH]; cbn-[equiv]; intros k e Hnodup.
+ rewrite empty_mapsto_iff, InA_nil; intuition.
+ inversion_clear Hnodup as [| ? ? Hnotin Hnodup'].
specialize (IH k e Hnodup'); clear Hnodup'.
rewrite add_mapsto_iff, InA_cons, <- IH.
unfold eq_key_elt in *.
split; destruct 1 as [H|H]; try (intuition; fail).
- - destruct (equiv_dec k k'); [left|right]; split; try (now (idtac + symmetry); auto); [|].
- * now destruct H.
- * elim c. now destruct H.
+ - left. destruct H. split.
+ * cbn[fst] in H. now symmetry.
+ * cbn in H0. now symmetry.
- destruct (equiv_dec k k').
- * left. elim Hnotin. apply InA_eq_key_elt_eq_key with k e; intuition.
+ * left. contradiction Hnotin. apply InA_eq_key_elt_eq_key with k e; intuition.
* right. now split; try symmetry.
Qed.
@@ -885,7 +888,7 @@ Section MoreWeakFacts.
NoDupA eq_key l ->
find k (of_list l) = findA (eqb k) l.
Proof.
- induction l as [|(k',e') l IH]; simpl; intros k Hnodup.
+ induction l as [|(k',e') l IH]; cbn; intros k Hnodup.
apply empty_o.
inversion_clear Hnodup as [| ? ? Hnotin Hnodup'].
specialize (IH k Hnodup'); clear Hnodup'.
@@ -942,11 +945,11 @@ Section MoreWeakFacts.
{ intros k e; unfold l. now rewrite <- find_mapsto_iff, InA_rev, elements_mapsto_iff. }
clearbody l. clearbody ff. clear Hstep f. revert m Hsame. induction l.
(* empty *)
- intros m Hsame; simpl.
+ intros m Hsame; cbn.
apply Hempty. intros k e.
rewrite find_mapsto_iff, Hsame; intro Habs; inversion Habs.
(* step *)
- intros m Hsame; destruct a as (k,e); simpl.
+ intros m Hsame; destruct a as (k,e); cbn.
apply Hstep' with (of_list l); auto.
- inversion_clear Hdup. contradict H. destruct H as (e',He').
apply InA_eq_key_elt_eq_key with k e'; auto. now rewrite <- of_list_1.
@@ -958,7 +961,7 @@ Section MoreWeakFacts.
* destruct (find k' m) eqn:Habs; trivial.
exfalso. rewrite Hsame in Habs.
inversion_clear Habs.
- -- elim c. now destruct H1.
+ -- contradiction c. now destruct H1.
-- rewrite <- of_list_1, find_mapsto_iff in H1; trivial.
rewrite H1 in Hin. discriminate.
- apply IHl.
@@ -983,7 +986,7 @@ Section MoreWeakFacts.
apply fold_rec; intros.
apply Pmorphism with (empty _); auto. intro k. rewrite empty_o.
case_eq (find k m0); auto; intros e'; rewrite <- find_mapsto_iff.
- intro H'; elim (H k e'); auto.
+ intro H'; contradiction (H k e'); auto.
apply Pmorphism with (add k e m'); try intro; auto.
Qed.
@@ -1062,7 +1065,7 @@ Section MoreWeakFacts.
intros m' Heq k'.
rewrite empty_o.
case_eq (find k' m'); auto; intros e'; rewrite <- find_mapsto_iff.
- intro; elim (Heq k' e'); auto.
+ intro; contradiction (Heq k' e'); auto.
intros k e a m' m'' _ _ Hadd Heq k'.
rewrite Hadd, 2 add_o, Heq; auto.
Qed.
@@ -1093,7 +1096,7 @@ Section MoreWeakFacts.
Proof using HF st.
intros. apply fold_rec_nodep with (P:=fun a => eqA a i).
reflexivity.
- intros. elim (H k e); auto.
+ intros. contradiction (H k e); auto.
Qed.
(** As noticed by P. Casteran, asking for the general [SetoidList.transpose]
@@ -1142,10 +1145,10 @@ Section MoreWeakFacts.
(apply NoDupA_rev; [typeclasses eauto | apply elements_3]).
apply fold_right_equivlistA_restr with (R:=complement eq_key)(eqA:=eq_key_elt);
auto with map; try typeclasses eauto.
- intros (k1,e1) (k2,e2) (Hk,He) a1 a2 Ha; simpl in *; apply Comp; auto.
+ intros (k1,e1) (k2,e2) (Hk,He) a1 a2 Ha; cbn in *; apply Comp; auto.
unfold complement, eq_key, eq_key_elt; repeat red.
intros ? ? Heq ? ? Heq'. rewrite Heq, Heq'. tauto.
- intros (k,e) (k',e'); unfold eq_key; simpl; auto with *.
+ intros (k,e) (k',e'); unfold eq_key; cbn; auto with *.
rewrite <- NoDupA_altdef; auto.
intros (k,e).
rewrite 2 InA_rev; try apply eq_key_elt_Equiv.
@@ -1159,27 +1162,23 @@ Section MoreWeakFacts.
eqA (fold f m2 i) (f k e (fold f m1 i)).
Proof using Comp HF Tra st.
assert (eq_key_elt_refl : forall p, eq_key_elt p p).
- red; auto.
+ { red. auto. }
assert (eq_key_elt_sym : forall p p', eq_key_elt p p' -> eq_key_elt p' p).
- intros (x1,x2) (y1,y2); unfold eq_key_elt; simpl; intuition.
+ { intros (x1,x2) (y1,y2); unfold eq_key_elt; cbn; intuition. }
assert (eq_key_elt_trans : forall p p' p'',
eq_key_elt p p' -> eq_key_elt p' p'' -> eq_key_elt p p'').
- intros (x1,x2) (y1,y2) (z1,z2); unfold eq_key_elt; simpl.
- intuition; subst; auto; transitivity y1; auto.
+ { intros (x1,x2) (y1,y2) (z1,z2); unfold eq_key_elt. etransitivity; eauto. }
intros; do 2 rewrite fold_1; do 2 rewrite <- fold_left_rev_right.
set (f':=fun y x0 => f (fst y) (snd y) x0) in *.
change (f k e (fold_right f' i (rev (elements m1))))
with (f' (k,e) (fold_right f' i (rev (elements m1)))).
apply fold_right_add_restr with
- (R:=complement eq_key)(eqA:=eq_key_elt)(eqB:=eqA); auto.
- typeclasses eauto.
+ (R:=complement eq_key)(eqA:=eq_key_elt)(eqB:=eqA); eauto with typeclass_instances.
intros (k1,e1) (k2,e2) (Hk,He) a1 a2 Ha; unfold f';
- simpl in *. apply Comp; auto.
- unfold complement, eq_key, eq_key_elt; repeat red.
- intros ? ? Habs Heq. apply Habs. now symmetry.
+ cbn in *. apply Comp; auto.
unfold complement, eq_key, eq_key_elt; repeat red.
intros ? ? Heq ? ? Heq'. rewrite Heq, Heq'. tauto.
- unfold f'; intros (k1,e1) (k2,e2); unfold eq_key; simpl; auto.
+ unfold f'; intros (k1,e1) (k2,e2); unfold eq_key; cbn; auto.
apply NoDupA_rev; auto using eq_key_elt_Equivalence;
apply NoDupA_eq_key_eq_key_elt; apply elements_3.
apply NoDupA_rev; auto using eq_key_elt_Equivalence;
@@ -1194,7 +1193,7 @@ Section MoreWeakFacts.
rewrite InA_cons; do 2 (rewrite InA_rev by apply eq_key_elt_Equivalence);
destruct a as (a,b); fold eq_key_elt;
do 2 rewrite <- elements_mapsto_iff.
- do 2 rewrite find_mapsto_iff; unfold eq_key_elt; simpl.
+ do 2 rewrite find_mapsto_iff; unfold eq_key_elt; cbn.
rewrite H0.
rewrite add_o.
destruct (equiv_dec k a); intuition try (easy || congruence).
@@ -1262,7 +1261,7 @@ Section MoreWeakFacts.
generalize (elements_mapsto_iff m).
destruct (elements m); try discriminate.
exists p; auto.
- rewrite H0; destruct p; simpl; auto.
+ rewrite H0; destruct p; cbn; auto.
Qed.
Lemma cardinal_inv_2b :
@@ -1270,7 +1269,7 @@ Section MoreWeakFacts.
Proof using HF.
intros.
generalize (@cardinal_inv_2 m); destruct @cardinal.
- elim H;auto.
+ contradiction H;auto.
eauto.
Qed.
@@ -1325,16 +1324,16 @@ Section MoreWeakFacts.
intro m. pattern m, (fold f' m (empty _)). apply fold_rec.
intros m' Hm' k e. rewrite empty_mapsto_iff. intuition.
- elim (Hm' k e); auto.
+ contradiction (Hm' k e); auto.
intros k e acc m1 m2 Hke Hn Hadd IH k' e'.
change (Equal m2 (add k e m1)) in Hadd; rewrite Hadd.
- unfold f'; simpl.
- case_eq (f k e); intros Hfke; simpl;
+ unfold f'; cbn.
+ case_eq (f k e); intros Hfke; cbn;
rewrite !add_mapsto_iff, IH; clear IH; intuition.
rewrite <- Hfke; apply Hf; auto.
destruct (equiv_dec k k') as [Hk|Hk]; [left|right]; auto.
- elim Hn; exists e'; rewrite Hk; auto.
+ contradiction Hn; exists e'; rewrite Hk; auto.
assert (f k e = f k' e') by (apply Hf; auto). congruence.
Qed.
@@ -1345,11 +1344,11 @@ Section MoreWeakFacts.
set (f':=fun k e b => if f k e then b else false).
intro m. pattern m, (fold f' m true). apply fold_rec.
- intros m' Hm'. split; auto. intros _ k e Hke. elim (Hm' k e); auto.
+ intros m' Hm'. split; auto. intros _ k e Hke. contradiction (Hm' k e); auto.
intros k e b m1 m2 _ Hn Hadd IH. clear m.
change (Equal m2 (add k e m1)) in Hadd.
- unfold f'; simpl. case_eq (f k e); intros Hfke.
+ unfold f'; cbn. case_eq (f k e); intros Hfke.
(* f k e = true *)
rewrite IH. clear IH. split; intros Hmapsto k' e' Hke'.
rewrite Hadd, add_mapsto_iff in Hke'.
@@ -1372,18 +1371,18 @@ Section MoreWeakFacts.
intro m. pattern m, (fold f' m false). apply fold_rec.
intros m' Hm'. split; try (intros; discriminate).
- intros ((k,e),(Hke,_)); simpl in *. elim (Hm' k e); auto.
+ intros ((k,e),(Hke,_)); cbn in *. contradiction (Hm' k e); auto.
intros k e b m1 m2 _ Hn Hadd IH. clear m.
change (Equal m2 (add k e m1)) in Hadd.
- unfold f'; simpl. case_eq (f k e); intros Hfke.
+ unfold f'; cbn. case_eq (f k e); intros Hfke.
(* f k e = true *)
split; [intros _|auto].
- exists (k,e); simpl; split; auto.
+ exists (k,e); cbn; split; auto.
rewrite Hadd, add_mapsto_iff; auto.
(* f k e = false *)
- rewrite IH. clear IH. split; intros ((k',e'),(Hke1,Hke2)); simpl in *.
- exists (k',e'); simpl; split; auto.
+ rewrite IH. clear IH. split; intros ((k',e'),(Hke1,Hke2)); cbn in *.
+ exists (k',e'); cbn; split; auto.
rewrite Hadd, add_mapsto_iff; right; split; auto.
intro abs; contradict Hn; exists e'; rewrite abs; auto.
rewrite Hadd, add_mapsto_iff in Hke1. destruct Hke1 as [(?,?)|(?,?)].
@@ -1414,7 +1413,7 @@ Section MoreWeakFacts.
m1 = fst (partition f m) ->
(MapsTo k e m1 <-> MapsTo k e m /\ f k e = true).
Proof using HF Hf.
- unfold partition; simpl; intros. subst m1.
+ unfold partition; cbn; intros. subst m1.
apply filter_iff; auto.
Qed.
@@ -1422,10 +1421,10 @@ Section MoreWeakFacts.
m2 = snd (partition f m) ->
(MapsTo k e m2 <-> MapsTo k e m /\ f k e = false).
Proof using HF Hf.
- unfold partition; simpl; intros. subst m2.
+ unfold partition; cbn; intros. subst m2.
rewrite filter_iff.
split; intros (H,H'); split; auto.
- destruct (f k e); simpl in *; auto.
+ destruct (f k e); cbn in *; auto.
rewrite H'; auto.
repeat red; intros. f_equal. apply Hf; auto.
Qed.
@@ -1453,13 +1452,13 @@ Section MoreWeakFacts.
destruct (In_dec m1 k) as [H|H]; [left|right]; auto.
destruct Hm as (Hm,Hm').
destruct Hk as (e,He); rewrite Hm' in He; destruct He.
- elim H; exists e; auto.
+ contradiction H; exists e; auto.
exists e; auto.
Defined.
Lemma Disjoint_sym : forall m1 m2, Disjoint m1 m2 -> Disjoint m2 m1.
Proof using .
- intros m1 m2 H k (H1,H2). elim (H k); auto.
+ intros m1 m2 H k (H1,H2). contradiction (H k); auto.
Qed.
Lemma Partition_sym : forall m m1 m2,
@@ -1475,10 +1474,10 @@ Section MoreWeakFacts.
Proof using .
intros m m1 m2 (Hdisj,Heq). split.
intro He.
- split; intros k e Hke; elim (He k e); rewrite Heq; auto.
+ split; intros k e Hke; contradiction (He k e); rewrite Heq; auto.
intros (He1,He2) k e Hke. rewrite Heq in Hke. destruct Hke.
- elim (He1 k e); auto.
- elim (He2 k e); auto.
+ contradiction (He1 k e); auto.
+ contradiction (He2 k e); auto.
Qed.
Lemma Partition_Add :
@@ -1507,13 +1506,13 @@ Section MoreWeakFacts.
destruct (equiv_dec x k) as [He|Hne]; auto.
rewrite <- He; apply find_1; auto.
(* disjoint *)
- intros k (H1,H2). elim (Hdisj k). split; auto.
+ intros k (H1,H2). contradiction (Hdisj k). split; auto.
rewrite remove_in_iff in H1; destruct H1; auto.
(* mapsto *)
intros k' e'.
rewrite Heq, 2 remove_mapsto_iff, Hor.
intuition.
- intro abs; elim (Hdisj x); split; [exists e|exists e']; auto.
+ intro abs; contradiction (Hdisj x); split; [exists e|exists e']; auto.
apply MapsTo_1 with k'; auto.
(* second case : x in m2 *)
@@ -1525,13 +1524,13 @@ Section MoreWeakFacts.
destruct (equiv_dec x k) as [He|Hne]; auto.
rewrite <- He; apply find_1; auto.
(* disjoint *)
- intros k (H1,H2). elim (Hdisj k). split; auto.
+ intros k (H1,H2). contradiction (Hdisj k). split; auto.
rewrite remove_in_iff in H2; destruct H2; auto.
(* mapsto *)
intros k' e'.
rewrite Heq, 2 remove_mapsto_iff, Hor.
intuition.
- intro abs; elim (Hdisj x); split; [exists e'|exists e]; auto.
+ intro abs; contradiction (Hdisj x); split; [exists e'|exists e]; auto.
apply MapsTo_1 with k'; auto.
Qed.
@@ -1591,7 +1590,7 @@ Section MoreWeakFacts.
replace (fold f m 0) with (fold f m1 (fold f m2 0)).
rewrite <- cardinal_fold.
intros.
- apply fold_rel with (R:=fun u v => u = v + cardinal m2); simpl; auto.
+ apply fold_rel with (R:=fun u v => u = v + cardinal m2); cbn; auto.
symmetry; apply Partition_fold with (eqA:=@Logic.eq _); try red; auto.
compute; auto.
Qed.
@@ -1613,15 +1612,15 @@ Section MoreWeakFacts.
rewrite Hm'.
intuition.
exists e; auto.
- elim (Hm k); split; auto; exists e; auto.
+ contradiction (Hm k); split; auto; exists e; auto.
rewrite (@partition_iff_2 f Hf m m2') by auto.
unfold f.
rewrite <- not_mem_in_iff.
destruct Hm as (Hm,Hm').
rewrite Hm'.
intuition.
- elim (Hm k); split; auto; exists e; auto.
- elim H1; exists e; auto.
+ contradiction (Hm k); split; auto; exists e; auto.
+ contradiction H1; exists e; auto.
Qed.
Lemma update_mapsto_iff : forall m m' k e,
@@ -1635,7 +1634,7 @@ Section MoreWeakFacts.
intros m0 Hm0 k e.
assert (~In k m0) by (intros (e0,He0); apply (Hm0 k e0); auto).
intuition.
- elim (Hm0 k e); auto.
+ contradiction (Hm0 k e); auto.
intros k e m0 m1 m2 _ Hn Hadd IH k' e'.
change (Equal m2 (add k e m1)) in Hadd.
@@ -1647,7 +1646,7 @@ Section MoreWeakFacts.
Proof.
intros m m' k e H. rewrite update_mapsto_iff in H.
destruct (In_dec m' k) as [H'|H']; [left|right]; intuition.
- elim H'; exists e; auto.
+ contradiction H'; exists e; auto.
Defined.
Lemma update_in_iff : forall m m' k,
@@ -1659,7 +1658,7 @@ Section MoreWeakFacts.
destruct (In_dec m' k) as [H|H].
destruct H as (e,H). intros _; exists e.
rewrite update_mapsto_iff; left; auto.
- destruct 1 as [H'|H']; [|elim H; auto].
+ destruct 1 as [H'|H']; [|contradiction H; auto].
destruct H' as (e,H'). exists e.
rewrite update_mapsto_iff; right; auto.
Qed.
@@ -1751,7 +1750,7 @@ Section MoreWeakFacts.
intros k k' e e' i Hneq x.
rewrite !add_o.
destruct (equiv_dec k x); destruct (equiv_dec k' x); auto.
- elim Hneq. etransitivity; eauto.
+ contradiction Hneq. etransitivity; eauto.
apply fold_init with (eqA:=Equal); auto.
intros k k' Hk e e' He m m' Hm; rewrite Hk,He,Hm; red; auto.
Qed.
@@ -1766,14 +1765,14 @@ Section MoreWeakFacts.
pattern (mem k m2); rewrite Hm2. (* UGLY, see with Matthieu *)
destruct (mem k m2'); rewrite Hii'; auto.
apply fold_Equal with (eqA:=Equal); auto.
- intros k k' Hk e e' He m m' Hm; simpl in *.
+ intros k k' Hk e e' He m m' Hm; cbn in *.
pattern (mem k m2'); rewrite Hk. (* idem *)
destruct (mem k' m2'); rewrite ?Hk,?He,Hm; red; auto.
intros k k' e e' i Hneq x.
case_eq (mem k m2'); case_eq (mem k' m2'); intros; auto.
rewrite !add_o.
destruct (equiv_dec k x); destruct (equiv_dec k' x); auto.
- elim Hneq. etransitivity; eauto.
+ contradiction Hneq. etransitivity; eauto.
Qed.
Global Instance diff_m elt :
@@ -1784,16 +1783,16 @@ Section MoreWeakFacts.
apply fold_rel with (R:=Equal); try red; auto.
intros k e i i' H Hii' x.
pattern (mem k m2); rewrite Hm2. (* idem *)
- destruct (mem k m2'); simpl; rewrite Hii'; auto.
+ destruct (mem k m2'); cbn; rewrite Hii'; auto.
apply fold_Equal with (eqA:=Equal); auto.
- intros k k' Hk e e' He m m' Hm; simpl in *.
+ intros k k' Hk e e' He m m' Hm; cbn in *.
pattern (mem k m2'); rewrite Hk. (* idem *)
- destruct (mem k' m2'); simpl; rewrite ?Hk,?He,Hm; red; auto.
+ destruct (mem k' m2'); cbn; rewrite ?Hk,?He,Hm; red; auto.
intros k k' e e' i Hneq x.
- case_eq (mem k m2'); case_eq (mem k' m2'); intros; simpl; auto.
+ case_eq (mem k m2'); case_eq (mem k' m2'); intros; cbn; auto.
rewrite !add_o.
destruct (equiv_dec k x); destruct (equiv_dec k' x); auto.
- elim Hneq. etransitivity; eauto.
+ contradiction Hneq. etransitivity; eauto.
Qed.
End MoreWeakFacts.
@@ -1836,7 +1835,7 @@ Section OrdProperties.
apply SortA_equivlistA_eqlistA; auto.
Qed.
- Ltac clean_eauto := unfold K.eq_key_elt, K.ltk; simpl;
+ Ltac clean_eauto := unfold K.eq_key_elt, K.ltk; cbn;
intuition; try solve [order].
Definition gtb (p p':key*elt) :=
@@ -1848,26 +1847,26 @@ Section OrdProperties.
Lemma gtb_1 : forall p p', gtb p p' = true <-> ltk p' p.
Proof.
- intros (x,e) (y,e'); unfold gtb, K.ltk; simpl.
+ intros (x,e) (y,e'); unfold gtb, K.ltk; cbn.
destruct (compare_dec x y); intuition; try discriminate; order.
Qed.
Lemma leb_1 : forall p p', leb p p' = true <-> ~ltk p' p.
Proof.
- intros (x,e) (y,e'); unfold leb, gtb, K.ltk; simpl.
+ intros (x,e) (y,e'); unfold leb, gtb, K.ltk; cbn.
destruct (compare_dec x y); intuition; try discriminate; order.
Qed.
Lemma gtb_compat : forall p, Proper (eq_key_elt==>eq) (gtb p).
Proof.
- red; intros (x,e) (a,e') (b,e'') H; red in H; simpl in *; destruct H.
+ red; intros (x,e) (a,e') (b,e'') H; red in H; cbn in *; destruct H.
generalize (gtb_1 (x,e) (a,e'))(gtb_1 (x,e) (b,e''));
destruct (gtb (x,e) (a,e')); destruct (gtb (x,e) (b,e'')); auto.
- unfold KeyOrderedType.ltk in *; simpl in *; intros.
+ unfold KeyOrderedType.ltk in *; cbn in *; intros.
symmetry; rewrite H2.
apply eq_lt with a; auto.
rewrite <- H1; auto.
- unfold KeyOrderedType.ltk in *; simpl in *; intros.
+ unfold KeyOrderedType.ltk in *; cbn in *; intros.
rewrite H1.
apply eq_lt with b; auto.
rewrite <- H2; auto.
@@ -1887,8 +1886,8 @@ Section OrdProperties.
unfold elements_lt, elements_ge, leb; intros.
apply filter_split with (eqA:=eq_key) (ltA:=ltk); eauto with map.
intros; destruct x; destruct y; destruct p.
- rewrite gtb_1 in H; unfold K.ltk in H; simpl in *.
- unfold gtb, K.ltk in *; simpl in *.
+ rewrite gtb_1 in H; unfold K.ltk in H; cbn in *.
+ unfold gtb, K.ltk in *; cbn in *.
destruct (compare_dec k1 k0); intuition; try discriminate; order.
Qed.
@@ -1910,7 +1909,7 @@ Section OrdProperties.
intros.
rewrite filter_InA in H1; auto with *; destruct H1.
rewrite leb_1 in H2.
- destruct y; unfold KeyOrderedType.ltk in *; simpl in *.
+ destruct y; unfold KeyOrderedType.ltk in *; cbn in *.
rr; rewrite <- elements_mapsto_iff in H1.
assert (~ x == k).
contradict H.
@@ -1920,24 +1919,24 @@ Section OrdProperties.
intros.
rewrite filter_InA in H1; auto with *; destruct H1.
rewrite gtb_1 in H3.
- destruct y; destruct x0; unfold KeyOrderedType.ltk in *; simpl in *.
+ destruct y; destruct x0; unfold KeyOrderedType.ltk in *; cbn in *.
inversion_clear H2.
- red in H4; simpl in *; destruct H4.
+ red in H4; cbn in *; destruct H4.
order.
rewrite filter_InA in H4; auto with *; destruct H4.
rewrite leb_1 in H4.
- unfold KeyOrderedType.ltk in *; simpl in *; order.
+ unfold KeyOrderedType.ltk in *; cbn in *; order.
rr; red; intros a; destruct a.
rewrite InA_app_iff, InA_cons, 2 filter_InA,
<-2 elements_mapsto_iff, leb_1, gtb_1,
find_mapsto_iff, (H0 k), <- find_mapsto_iff,
add_mapsto_iff; try apply eq_key_elt_Equiv; auto with *.
- unfold eq_key_elt, KeyOrderedType.eq_key_elt, KeyOrderedType.ltk; simpl.
+ unfold eq_key_elt, KeyOrderedType.eq_key_elt, KeyOrderedType.ltk; cbn.
destruct (compare_dec k x);
replace (x =/= k) with (~ x == k) in *; intuition.
right; split; auto; order.
order.
- elim H.
+ contradiction H.
exists e0; apply MapsTo_1 with k; auto.
right; right; split; auto; order.
order.
@@ -1956,15 +1955,15 @@ Section OrdProperties.
destruct x0; destruct y.
rr; rewrite <- elements_mapsto_iff in H1.
unfold KeyOrderedType.eq_key_elt, KeyOrderedType.ltk in *;
- simpl in *; destruct H3.
+ cbn in *; destruct H3.
apply lt_eq with x; auto.
- apply H; simpl in *; subst; exists e0; assumption.
+ apply H; cbn in *; subst; exists e0; assumption.
inversion H3.
red; intros a; destruct a.
rr; rewrite InA_app_iff, InA_cons, InA_nil, <- 2 elements_mapsto_iff,
find_mapsto_iff, (H0 k), <- find_mapsto_iff,
add_mapsto_iff by (apply eq_key_elt_Equiv).
- unfold eq_key_elt, KeyOrderedType.eq_key_elt, complement; simpl; intuition.
+ unfold eq_key_elt, KeyOrderedType.eq_key_elt, complement; cbn; intuition.
destruct (equiv_dec x k); intuition auto.
exfalso.
assert (In k m).
@@ -1986,7 +1985,7 @@ Section OrdProperties.
destruct y; destruct x0.
rr; rewrite <- elements_mapsto_iff in H2.
unfold KeyOrderedType.eq_key_elt, KeyOrderedType.ltk in *;
- simpl in *; destruct H3.
+ cbn in *; destruct H3.
apply eq_lt with x; auto.
apply H; exists e0; assumption.
inversion H3.
@@ -1994,7 +1993,7 @@ Section OrdProperties.
rewrite InA_cons, <- 2 elements_mapsto_iff,
find_mapsto_iff, (H0 k), <- find_mapsto_iff,
add_mapsto_iff by (apply eq_key_elt_Equiv).
- unfold eq_key_elt, KeyOrderedType.eq_key_elt; simpl. intuition.
+ unfold eq_key_elt, KeyOrderedType.eq_key_elt; cbn. intuition.
destruct (equiv_dec x k); auto.
exfalso.
assert (In k m).
@@ -2038,30 +2037,30 @@ Section OrdProperties.
generalize (elements_3 m).
revert x e H y x0 H0 H1.
induction (elements m).
- simpl; intros; try discriminate.
+ cbn; intros; try discriminate.
intros.
- destruct a; destruct l; simpl in *.
+ destruct a; destruct l; cbn in *.
injection H; clear H; intros; subst.
inversion_clear H1.
- repeat red in H; simpl in *. destruct H; order.
- elim H0; eauto.
- inversion H; simpl in *.
+ repeat red in H; cbn in *. destruct H; order.
+ contradiction H0; eauto.
+ inversion H; cbn in *.
change (max_elt_aux (p::l) = Some (x,e)) in H.
generalize (IHl x e H); clear IHl; intros IHl.
inversion_clear H1; [ | inversion_clear H2; eauto ].
- red in H3; simpl in H3; destruct H3.
+ red in H3; cbn in H3; destruct H3.
destruct p as (p1,p2).
destruct (equiv_dec p1 x).
apply lt_eq with p1; auto.
inversion_clear H2.
inversion_clear H5.
- simpl in *; subst; rewrite H1.
+ cbn in *; subst; rewrite H1.
inversion H6; exact H5.
- simpl in *; subst.
+ cbn in *; subst.
transitivity p1; auto.
inversion_clear H2.
inversion_clear H5.
- red in H2; simpl in H2; order.
+ red in H2; cbn in H2; order.
inversion_clear H2.
eapply IHl; eauto.
intro Z; apply H4; order.
@@ -2074,8 +2073,8 @@ Section OrdProperties.
unfold max_elt in *.
rewrite elements_mapsto_iff.
induction (elements m).
- simpl; try discriminate.
- destruct a; destruct l; simpl in *.
+ cbn; try discriminate.
+ destruct a; destruct l; cbn in *.
injection H; intros; subst; constructor; red; auto.
constructor 2; auto.
Qed.
@@ -2087,7 +2086,7 @@ Section OrdProperties.
unfold max_elt in *.
rewrite elements_Empty.
induction (elements m); auto.
- destruct a; destruct l; simpl in *; try discriminate.
+ destruct a; destruct l; cbn in *; try discriminate.
assert (H':=IHl H); discriminate.
Qed.
@@ -2109,16 +2108,16 @@ Section OrdProperties.
try discriminate.
destruct p; injection H; intros; subst.
inversion_clear H1.
- red in H2; destruct H2; simpl in *; order.
+ red in H2; destruct H2; cbn in *; order.
inversion_clear H4.
rewrite (@InfA_alt _ eq_key_elt) in H3; eauto with *.
apply (H3 (y,x0)); auto.
constructor; repeat intro.
- destruct x1; repeat red in H4; simpl in H4; order.
+ destruct x1; repeat red in H4; cbn in H4; order.
destruct x1; destruct y0; destruct z.
- unfold lt_key, KeyOrderedType.ltk in *; simpl in *; order.
+ unfold lt_key, KeyOrderedType.ltk in *; cbn in *; order.
unfold KeyOrderedType.eq_key_elt, lt_key, KeyOrderedType.ltk;
- repeat intro; simpl in *; intuition order.
+ repeat intro; cbn in *; intuition order.
Qed.
Lemma min_elt_MapsTo :
@@ -2128,8 +2127,8 @@ Section OrdProperties.
unfold min_elt in *.
rewrite elements_mapsto_iff.
destruct (elements m).
- simpl; try discriminate.
- destruct p; simpl in *.
+ cbn; try discriminate.
+ destruct p; cbn in *.
injection H; intros; subst; constructor; red; auto.
Qed.
@@ -2140,7 +2139,7 @@ Section OrdProperties.
unfold min_elt in *.
rewrite elements_Empty.
destruct (elements m); auto.
- destruct p; simpl in *; discriminate.
+ destruct p; cbn in *; discriminate.
Qed.
End Min_Max_Elt.
@@ -2219,7 +2218,7 @@ Section OrdProperties.
do 2 rewrite fold_1.
do 2 rewrite <- fold_left_rev_right.
apply fold_right_eqlistA with (eqA:=eq_key_elt) (eqB:=eqA); auto.
- intros (k,e) (k',e') (Hk,He) a a' Ha; simpl in *; apply Hf; auto.
+ intros (k,e) (k',e') (Hk,He) a a' Ha; cbn in *; apply Hf; auto.
apply eqlistA_rev. apply elements_Equal_eqlistA. auto.
Qed.
@@ -2235,10 +2234,10 @@ Section OrdProperties.
transitivity (fold_right f' i (rev (elements m1 ++ (x,e)::nil))).
apply fold_right_eqlistA with (eqA:=eq_key_elt) (eqB:=eqA); auto.
intros (k1,e1) (k2,e2) (Hk,He) a1 a2 Ha;
- unfold f'; simpl in *; apply H; auto.
+ unfold f'; cbn in *; apply H; auto.
apply eqlistA_rev.
apply elements_Add_Above; auto.
- rewrite distr_rev; simpl.
+ rewrite distr_rev; cbn.
reflexivity.
Qed.
@@ -2254,10 +2253,10 @@ Section OrdProperties.
transitivity (fold_right f' i (rev (((x,e)::nil)++elements m1))).
apply fold_right_eqlistA with (eqA:=eq_key_elt) (eqB:=eqA); auto.
intros (k1,e1) (k2,e2) (Hk,He) a1 a2 Ha;
- unfold f'; simpl in *; apply H; auto.
+ unfold f'; cbn in *; apply H; auto.
apply eqlistA_rev.
- simpl; apply elements_Add_Below; auto.
- rewrite distr_rev; simpl.
+ cbn; apply elements_Add_Below; auto.
+ rewrite distr_rev; cbn.
rewrite fold_right_app.
reflexivity.
Qed.
diff --git a/Util/FMaps/FMapInterface.v b/Util/FMaps/FMapInterface.v
index f33579924c1c579b570b5f475d1a1593d63ce68e..a730867b7ff6dfe06010774357ac7e2ea3e36b1c 100644
--- a/Util/FMaps/FMapInterface.v
+++ b/Util/FMaps/FMapInterface.v
@@ -2,6 +2,7 @@
Require Import SetoidList.
Require Import SetoidDec.
+Require Import Pactole.Util.SetoidDefs.
(* Require Import Morphisms. *)
Generalizable All Variables.
@@ -10,25 +11,7 @@ Generalizable All Variables.
finite maps. *)
Definition Cmp {elt : Type} (cmp : elt -> elt -> bool) e1 e2 := cmp e1 e2 = true.
-
-Instance prod_Setoid A B {SA : Setoid A} {SB : Setoid B} : Setoid (A * B).
-simple refine {| equiv := fun xn yp => fst xn == fst yp /\ snd xn == snd yp |}; auto; [].
-Proof. split.
-+ repeat intro; now split.
-+ repeat intro; split; now symmetry.
-+ intros ? ? ? [? ?] [? ?]; split; etransitivity; eauto.
-Defined.
-
-Instance prod_EqDec A B `{EqDec A} `{EqDec B} : @EqDec (A * B) _.
-refine (fun xn yp => if equiv_dec (fst xn) (fst yp) then
- if equiv_dec (snd xn) (snd yp) then left _ else right _
- else right _).
-Proof.
-- now split.
-- abstract (intros [? ?]; contradiction).
-- abstract (intros [? ?]; contradiction).
-Defined.
-
+
(** * [FMaps] : the interface of maps
We define the class [FMap] of structures that implement finite
@@ -94,7 +77,7 @@ Class FMap `{EqDec key} := {
FMap_Setoid : forall `{Setoid elt}, Setoid (dict elt);
FMap_EqDec :> forall `{EqDec elt}, @EqDec (dict elt) FMap_Setoid *)
}.
-Arguments dict key%type_scope {S0} {H} {FMap} elt%type_scope.
+Arguments dict key%_type_scope {S0} {H} {FMap} elt%_type_scope.
(** Map notations (see below) are interpreted in scope [map_scope],
delimited with key [scope]. We bind it to the type [map] and to
@@ -102,18 +85,18 @@ Arguments dict key%type_scope {S0} {H} {FMap} elt%type_scope.
Declare Scope map_scope.
Delimit Scope map_scope with map.
Bind Scope map_scope with dict.
-Arguments MapsTo {key%type_scope} {_} {_} {_} {elt%type_scope} _ _ _%map_scope.
-Arguments is_empty {key%type_scope} {_} {_} {_} {elt%type_scope} _%map_scope.
-Arguments mem {key%type_scope} {_} {_} {_} {elt%type_scope} _ _%map_scope.
-Arguments add {key%type_scope} {_} {_} {_} {elt%type_scope} _ _ _%map_scope.
-Arguments find {key%type_scope} {_} {_} {_} {elt%type_scope} _ _%map_scope.
-Arguments remove {key%type_scope} {_} {_} {_} {elt%type_scope} _ _%map_scope.
-Arguments equal {key%type_scope} {_} {_} {_} {elt%type_scope} _ _%map_scope _%map_scope.
-Arguments map {key%type_scope} {_} {_} {_} {elt%type_scope} {elt'%type_scope} _ _%map_scope.
-Arguments mapi {key%type_scope} {_} {_} {_} {elt%type_scope} {elt'%type_scope} _ _%map_scope.
-Arguments fold {key%type_scope} {_} {_} {_} {elt%type_scope} {_%type_scope} _ _%map_scope _.
-Arguments cardinal {key%type_scope} {_} {_} {_} {elt%type_scope} _%map_scope.
-Arguments elements {key%type_scope} {_} {_} {_} {elt%type_scope} _%map_scope.
+Arguments MapsTo {key%_type_scope} {_} {_} {_} {elt%_type_scope} _ _ _%_map_scope.
+Arguments is_empty {key%_type_scope} {_} {_} {_} {elt%_type_scope} _%_map_scope.
+Arguments mem {key%_type_scope} {_} {_} {_} {elt%_type_scope} _ _%_map_scope.
+Arguments add {key%_type_scope} {_} {_} {_} {elt%_type_scope} _ _ _%_map_scope.
+Arguments find {key%_type_scope} {_} {_} {_} {elt%_type_scope} _ _%_map_scope.
+Arguments remove {key%_type_scope} {_} {_} {_} {elt%_type_scope} _ _%_map_scope.
+Arguments equal {key%_type_scope} {_} {_} {_} {elt%_type_scope} _ _%_map_scope _%_map_scope.
+Arguments map {key%_type_scope} {_} {_} {_} {elt%_type_scope} {elt'%_type_scope} _ _%_map_scope.
+Arguments mapi {key%_type_scope} {_} {_} {_} {elt%_type_scope} {elt'%_type_scope} _ _%_map_scope.
+Arguments fold {key%_type_scope} {_} {_} {_} {elt%_type_scope} {_%_type_scope} _ _%_map_scope _.
+Arguments cardinal {key%_type_scope} {_} {_} {_} {elt%_type_scope} _%_map_scope.
+Arguments elements {key%_type_scope} {_} {_} {_} {elt%_type_scope} _%_map_scope.
(** All projections should be made opaque for tactics using [delta]-conversion,
otherwise the underlying instances may appear during proofs, which then
@@ -271,22 +254,22 @@ Class FMapSpecs_adjust `(FMap key) := {
}. *)
Class FMapSpecs `(F : FMap key) := {
- FFMapSpecs_MapsTo :> FMapSpecs_MapsTo F;
- FFMapSpecs_mem :> FMapSpecs_mem F;
- FFMapSpecs_empty :> FMapSpecs_empty F;
- FFMapSpecs_is_empty :> FMapSpecs_is_empty F;
- FFMapSpecs_add :> FMapSpecs_add F;
- FFMapSpecs_remove :> FMapSpecs_remove F;
- FFMapSpecs_find :> FMapSpecs_find F;
- FFMapSpecs_elements :> FMapSpecs_elements F;
- FFMapSpecs_cardinal :> FMapSpecs_cardinal F;
- FFMapSpecs_fold :> FMapSpecs_fold F;
- FFMapSpecs_equal :> FMapSpecs_equal F;
- FFMapSpecs_map :> FMapSpecs_map F;
- FFMapSpecs_mapi :> FMapSpecs_mapi F;
-(* FFMapSpecs_map2 :> FMapSpecs_map2 F; *)
-(* FFMapSpecs_insert :> FMapSpecs_insert F; *)
-(* FFMapSpecs_adjust :> FMapSpecs_adjust F *)
+ #[global] FFMapSpecs_MapsTo :: FMapSpecs_MapsTo F;
+ #[global] FFMapSpecs_mem :: FMapSpecs_mem F;
+ #[global] FFMapSpecs_empty :: FMapSpecs_empty F;
+ #[global] FFMapSpecs_is_empty :: FMapSpecs_is_empty F;
+ #[global] FFMapSpecs_add :: FMapSpecs_add F;
+ #[global] FFMapSpecs_remove :: FMapSpecs_remove F;
+ #[global] FFMapSpecs_find :: FMapSpecs_find F;
+ #[global] FFMapSpecs_elements :: FMapSpecs_elements F;
+ #[global] FFMapSpecs_cardinal :: FMapSpecs_cardinal F;
+ #[global] FFMapSpecs_fold :: FMapSpecs_fold F;
+ #[global] FFMapSpecs_equal :: FMapSpecs_equal F;
+ #[global] FFMapSpecs_map :: FMapSpecs_map F;
+ #[global] FFMapSpecs_mapi :: FMapSpecs_mapi F;
+(* #[global] FFMapSpecs_map2 :: FMapSpecs_map2 F; *)
+(* #[global] FFMapSpecs_insert :: FMapSpecs_insert F; *)
+(* #[global] FFMapSpecs_adjust :: FMapSpecs_adjust F *)
}.
(* About Build_FMapSpecs. *)
(* About FMapSpecs. *)
diff --git a/Util/FMaps/FMapList.v b/Util/FMaps/FMapList.v
index 4786e36fcbe12834a303321ef6f70c2cd70ab7ec..7b7378dca4ba00be3bc25cbd2071fef72b3e5394 100644
--- a/Util/FMaps/FMapList.v
+++ b/Util/FMaps/FMapList.v
@@ -87,9 +87,9 @@ Lemma list_add_3 : forall (m : t elt) x y e e',
x =/= y -> InA (equiv@@1) (y, e) (list_add x e' m) -> InA (equiv@@1) (y, e) m.
Proof using .
intros m x y e e' Hxy Hy. simpl. induction m as [| [z p] l].
-+ inversion_clear Hy; try inversion H0. now elim Hxy.
++ inversion_clear Hy; try inversion H0. now contradiction Hxy.
+ simpl in *. destruct (equiv_dec x z).
- - right. inversion_clear Hy; trivial. now elim Hxy.
+ - right. inversion_clear Hy; trivial. now contradiction Hxy.
- inversion_clear Hy; now left + (right; apply IHl).
Qed.
@@ -168,7 +168,7 @@ Definition t_mapi {elt'} (f : key -> elt -> elt') (s : tt elt) : tt elt' :=
End ListOperations.
(** The full set of operations. *)
-Instance MapList key `{EqDec key} : FMap := {|
+Global Instance MapList key `{EqDec key} : FMap := {|
dict := fun elt => sig (@NoDupA (key * elt) (equiv@@1));
MapsTo := fun elt k e m => InA equiv (k, e) (proj1_sig m);
empty := fun elt => (exist _ nil (NoDupA_nil (equiv@@1)));
@@ -191,7 +191,7 @@ Local Notation eq_pair := (fun xn yp => fst xn == fst yp /\ snd xn = snd yp).
(** ** Proofs of the specifications **)
-Instance MapListFacts_MapsTo key `{EqDec key} : FMapSpecs_MapsTo MapList.
+Global Instance MapListFacts_MapsTo key `{EqDec key} : FMapSpecs_MapsTo MapList.
Proof using .
split. intros elt [m Hm] x y e Hxy Hx. simpl in *.
induction m; inversion_clear Hx.
@@ -199,10 +199,10 @@ induction m; inversion_clear Hx.
- right. inversion_clear Hm. now apply IHm.
Qed.
-Instance MapListFacts_mem key `{EqDec key} : FMapSpecs_mem MapList.
+Global Instance MapListFacts_mem key `{EqDec key} : FMapSpecs_mem MapList.
Proof using . split.
* intros elt [m Hm] x [e Hin]. simpl in *. induction m as [| [y n] l]; inversion_clear Hin.
- + simpl. destruct (equiv_dec x y) as [Hxy | Hxy]; trivial. elim Hxy. now destruct H0.
+ + simpl. destruct (equiv_dec x y) as [Hxy | Hxy]; trivial. contradiction Hxy. now destruct H0.
+ simpl. destruct (equiv_dec x y) as [Hxy | Hxy]; trivial. inversion_clear Hm. auto.
* intros elt [m Hm] x Hmem. unfold In. simpl in *. induction m as [| [y n] l]; simpl in Hmem.
+ discriminate.
@@ -212,18 +212,18 @@ Proof using . split.
destruct Hmem as [e ?]. exists e. now right.
Qed.
-Instance MapListFacts_empty key `{EqDec key} : FMapSpecs_empty MapList.
+Global Instance MapListFacts_empty key `{EqDec key} : FMapSpecs_empty MapList.
Proof using . split. intros elt x e Hin. inversion Hin. Qed.
-Instance MapListFacts_is_empty key `{EqDec key} : FMapSpecs_is_empty MapList.
+Global Instance MapListFacts_is_empty key `{EqDec key} : FMapSpecs_is_empty MapList.
Proof using . split.
* intros elt [m Hm] Hm'. destruct m as [| [x n] l]; trivial.
- elim Hm' with x n. now left.
+ contradiction Hm' with x n. now left.
* intros elt [m Hm] Hm'. destruct m as [| [x n] l]; try discriminate.
intros x n Hin. inversion Hin.
Qed.
-Instance MapListFacts_add key `{EqDec key} : FMapSpecs_add MapList.
+Global Instance MapListFacts_add key `{EqDec key} : FMapSpecs_add MapList.
Proof using . split.
* intros elt [m Hm] x y e Hxy. simpl in *. induction m as [| [z p] l]; simpl.
+ now left.
@@ -232,28 +232,28 @@ Proof using . split.
+ inversion Hy.
+ simpl. destruct (equiv_dec x z).
- right. inversion_clear Hy; trivial.
- elim Hxy. destruct H0. now transitivity z.
+ contradiction Hxy. destruct H0. now transitivity z.
- inversion_clear Hm. inversion_clear Hy; now left + (right; apply IHl).
* intros elt [m Hm] x y e e' Hxy Hy. simpl in *. induction m as [| [z p] l].
- + inversion_clear Hy; inversion H0. now elim Hxy.
+ + inversion_clear Hy; inversion H0. now contradiction Hxy.
+ simpl in *. destruct (equiv_dec x z).
- - right. inversion_clear Hy; trivial. now elim Hxy.
+ - right. inversion_clear Hy; trivial. now contradiction Hxy.
- inversion_clear Hm. inversion_clear Hy; now left + (right; apply IHl).
Qed.
-Instance MapListFacts_remove key `{EqDec key} : FMapSpecs_remove MapList.
+Global Instance MapListFacts_remove key `{EqDec key} : FMapSpecs_remove MapList.
Proof using . split.
* intros elt [m Hm] x y Hxy. simpl. unfold t_remove, In. simpl. induction m as [| [z p] l].
+ simpl. intros [? Habs]. inversion Habs.
+ simpl. inversion_clear Hm. destruct (equiv_dec x z) as [Hxz | Hxz]; auto; [].
intros [n Habs]. inversion_clear Habs.
- - elim Hxz. destruct H2. now transitivity y.
+ - contradiction Hxz. destruct H2. now transitivity y.
- apply IHl; eauto.
* intros elt [m Hm] x y e Hxy Hy. simpl in *. induction m as [| [z p] l].
+ inversion Hy.
+ inversion_clear Hm. simpl. destruct (equiv_dec x z).
- inversion_clear Hy; simpl in *; auto; [].
- elim Hxy. destruct H2. now transitivity z.
+ contradiction Hxy. destruct H2. now transitivity z.
- inversion_clear Hy; now left + (right; apply IHl).
* intros elt [m Hm] x y e Hy. simpl in *. induction m as [| [z p] l].
+ inversion_clear Hy.
@@ -261,14 +261,14 @@ Proof using . split.
inversion_clear Hy; now left + (right; apply IHl).
Qed.
-Instance MapListFacts_find key `{EqDec key} : FMapSpecs_find MapList.
+Global Instance MapListFacts_find key `{EqDec key} : FMapSpecs_find MapList.
Proof using . split.
* intros elt [m Hm] x e Hin. simpl in *. induction m as [| [y p] l].
+ inversion Hin.
+ inversion_clear Hm. simpl. destruct (equiv_dec x y).
- inversion_clear Hin; try (now f_equal); [].
assert (Heq : equiv@@1 (x, e) (y, p)) by assumption.
- elim H0. eapply InA_eqA; eauto with typeclass_instances; [].
+ contradiction H0. eapply InA_eqA; eauto with typeclass_instances; [].
revert H2. apply InA_impl_compat; trivial; [].
now repeat intro.
- inversion_clear Hin; now auto.
@@ -279,17 +279,17 @@ Proof using . split.
- right. auto.
Qed.
-Instance MapListFacts_elements key `{EqDec key} : FMapSpecs_elements MapList.
+Global Instance MapListFacts_elements key `{EqDec key} : FMapSpecs_elements MapList.
Proof using . split.
* tauto.
* tauto.
* intros elt [m Hm]. simpl. assumption.
Qed.
-Instance MapListFacts_cardinal key `{EqDec key} : FMapSpecs_cardinal MapList.
+Global Instance MapListFacts_cardinal key `{EqDec key} : FMapSpecs_cardinal MapList.
Proof using . split. tauto. Qed.
-Instance MapListFacts_fold key `{EqDec key} : FMapSpecs_fold MapList.
+Global Instance MapListFacts_fold key `{EqDec key} : FMapSpecs_fold MapList.
Proof using . split.
intros elt [m Hm] A i f. simpl. revert i. induction m as [| [y p] l]; simpl.
- reflexivity.
@@ -361,7 +361,7 @@ intros [m Hm]. induction m as [| [k e] m].
Qed.
-Instance MapListFacts_equal key `{EqDec key} : FMapSpecs_equal MapList.
+Global Instance MapListFacts_equal key `{EqDec key} : FMapSpecs_equal MapList.
Proof using . split.
* unfold Equivb, equal.
intuition.
@@ -374,7 +374,7 @@ Proof using . split.
firstorder.
Qed.
-Instance MapListFacts_map key `{EqDec key} : FMapSpecs_map MapList.
+Global Instance MapListFacts_map key `{EqDec key} : FMapSpecs_map MapList.
Proof using . split.
* intros elt elt' [m Hm] x e f Hin. simpl in *. induction m as [| [y p] m].
+ inversion Hin.
@@ -382,7 +382,7 @@ Proof using . split.
- left. simpl. split; trivial. inversion_clear Hin.
-- simpl in *. destruct H2. now subst.
-- assert (Heq : equiv@@1 (x, e) (y, p)) by assumption.
- elim H0. eapply InA_eqA; eauto with typeclass_instances; [].
+ contradiction H0. eapply InA_eqA; eauto with typeclass_instances; [].
revert H2. apply InA_impl_compat; trivial; [].
now repeat intro.
- inversion_clear Hin; try easy; [].
@@ -396,7 +396,7 @@ Proof using . split.
exists e'. now right.
Qed.
-Instance MapListFacts_mapi key `{EqDec key} : FMapSpecs_mapi MapList.
+Global Instance MapListFacts_mapi key `{EqDec key} : FMapSpecs_mapi MapList.
Proof using . split.
* intros elt elt' [m Hm] x e f Hin. simpl in *. induction m as [| [y p] m].
+ inversion Hin.
@@ -405,7 +405,7 @@ Proof using . split.
simpl. split; trivial. inversion_clear Hin.
-- simpl in *. destruct H2. now subst.
-- assert (Heq : equiv@@1 (x, e) (y, p)) by assumption.
- elim H0. eapply InA_eqA; eauto with typeclass_instances; [].
+ contradiction H0. eapply InA_eqA; eauto with typeclass_instances; [].
revert H2. apply InA_impl_compat; trivial; [].
now repeat intro.
- inversion_clear Hin; try easy; [].
@@ -421,5 +421,5 @@ Proof using . split.
Qed.
(** The full set of specifications. *)
-Instance MapListFacts key `{EqDec key} : FMapSpecs MapList.
+Global Instance MapListFacts key `{EqDec key} : FMapSpecs MapList.
Proof using . split; auto with typeclass_instances. Qed.
diff --git a/Util/FSets/FSetFacts.v b/Util/FSets/FSetFacts.v
index b0bb7e8a34880e2ae9fa8b9a868908aff574abfa..1fc67182a3326171d6b4cfa01a046b0863cc6f20 100644
--- a/Util/FSets/FSetFacts.v
+++ b/Util/FSets/FSetFacts.v
@@ -22,6 +22,9 @@ Local Open Scope equiv_scope.
#[export] Hint Extern 2 (equiv ?y ?x) => now symmetry : core.
#[export] Hint Extern 2 (Equivalence.equiv ?y ?x) => now symmetry : core.
+(* this will become non default soon. *)
+Ltac Tauto.intuition_solver ::= auto with *.
+
Notation Leibniz := (@eq _) (only parsing).
(** * Specifications written using equivalences *)
@@ -68,7 +71,7 @@ Section IffSpec.
split; [| destruct 1; [apply add_1 | apply add_2]]; auto.
destruct (Helt x y) as [E|E].
- intro. auto.
- - intro H; right. eauto using add_3.
+ - intro H; right. eapply add_3;eauto. (* stopped working eauto using eauto *)
Qed.
Lemma add_other : x =/= y -> (In y (add x s) <-> In y s).
@@ -122,7 +125,7 @@ Section IffSpec.
Lemma exists_spec : exists_ f s = true <-> Exists (fun x => f x = true) s.
Proof using HF Hf. split; [eapply exists_2 | eapply exists_1]; eauto. Qed.
End ForFilter.
- Arguments InA {A%type_scope} _ _ _.
+ Arguments InA {A%_type_scope} _ _ _.
End IffSpec.
@@ -293,14 +296,14 @@ Section BoolSpec.
End BoolSpec.
-Instance In_m `{HF : @FSetSpecs A St HA F} :
+Global Instance In_m `{HF : @FSetSpecs A St HA F} :
Proper (equiv ==> equiv ==> iff) In.
Proof using .
intros x y H s s' H0.
rewrite (In_eq_iff s H); auto.
Qed.
-Instance is_empty_m `{HF : @FSetSpecs A St HA F} :
+Global Instance is_empty_m `{HF : @FSetSpecs A St HA F} :
Proper (equiv ==> @eq bool) is_empty.
Proof using .
intros s s' H.
@@ -311,10 +314,10 @@ Proof using .
- now rewrite H0, H, <- H1.
Qed.
-Instance Empty_m `{HF : @FSetSpecs A St HA F} : Proper (equiv ==> iff) Empty.
+Global Instance Empty_m `{HF : @FSetSpecs A St HA F} : Proper (equiv ==> iff) Empty.
Proof using . unfold Empty. intros ? ? H. now setoid_rewrite H. Qed.
-Instance mem_m `{HF : @FSetSpecs A St HA F} :
+Global Instance mem_m `{HF : @FSetSpecs A St HA F} :
Proper (equiv ==> equiv ==> @eq bool) mem.
Proof using .
intros x y H s s' H0.
@@ -323,7 +326,7 @@ Proof using .
destruct (mem x s); destruct (mem y s'); intuition.
Qed.
-Instance singleton_m `{HF : @FSetSpecs A St HA F} :
+Global Instance singleton_m `{HF : @FSetSpecs A St HA F} :
Proper (equiv ==> equiv) singleton.
Proof using .
intros x y H a.
@@ -333,42 +336,42 @@ Proof using .
- transitivity y; auto.
Qed.
-Instance add_m `{HF : @FSetSpecs A St HA F} :
+Global Instance add_m `{HF : @FSetSpecs A St HA F} :
Proper (equiv ==> equiv ==> equiv) add.
Proof using .
intros x y H s s' H0 a.
do 2 rewrite add_spec; rewrite H; rewrite H0; intuition.
Qed.
-Instance remove_m `{HF : @FSetSpecs A St HA F} :
+Global Instance remove_m `{HF : @FSetSpecs A St HA F} :
Proper (equiv ==> equiv ==> equiv) remove.
Proof using .
intros x y H s s' H0 a.
do 2 rewrite remove_spec; rewrite H; rewrite H0; intuition.
Qed.
-Instance union_m `{HF : @FSetSpecs A St HA F} :
+Global Instance union_m `{HF : @FSetSpecs A St HA F} :
Proper (equiv ==> equiv ==> equiv) union.
Proof using .
intros s s' H s'' s''' H0 a.
do 2 rewrite union_spec; rewrite H; rewrite H0; intuition.
Qed.
-Instance inter_m `{HF : @FSetSpecs A St HA F} :
+Global Instance inter_m `{HF : @FSetSpecs A St HA F} :
Proper (equiv ==> equiv ==> equiv) inter.
Proof using .
intros s s' H s'' s''' H0 a.
do 2 rewrite inter_spec; rewrite H; rewrite H0; intuition.
Qed.
-Instance diff_m `{HF : @FSetSpecs A St HA F} :
+Global Instance diff_m `{HF : @FSetSpecs A St HA F} :
Proper (equiv ==> equiv ==> equiv) diff.
Proof using .
intros s s' H s'' s''' H0 a.
do 2 rewrite diff_spec; rewrite H; rewrite H0; intuition.
Qed.
-Instance elements_compat `{HF : @FSetSpecs A St HA F} :
+Global Instance elements_compat `{HF : @FSetSpecs A St HA F} :
Proper (equiv ==> PermutationA equiv) elements.
Proof using .
intros s s' Heq. apply NoDupA_equivlistA_PermutationA.
@@ -378,20 +381,20 @@ intros s s' Heq. apply NoDupA_equivlistA_PermutationA.
+ intro x. rewrite 2 elements_spec. apply Heq.
Qed.
-Instance cardinal_compat `{HF : @FSetSpecs A St HA F} : Proper (equiv ==> Logic.eq) cardinal.
+Global Instance cardinal_compat `{HF : @FSetSpecs A St HA F} : Proper (equiv ==> Logic.eq) cardinal.
Proof using . intros ? ? Heq. rewrite 2 cardinal_spec. now do 2 f_equiv. Qed.
-Instance For_all_compat `{HF : @FSetSpecs A St HA F} :
+Global Instance For_all_compat `{HF : @FSetSpecs A St HA F} :
Proper ((equiv ==> impl) ==> equiv ==> impl) For_all.
Proof using .
intros P Q HPQ s1 s2 Hs HP x Hin.
apply (HPQ x x ltac:(reflexivity)), HP. now rewrite Hs.
Qed.
-Instance PermutationA_length {elt} `{Setoid elt} : Proper (PermutationA equiv ==> Logic.eq) (@length elt).
+Global Instance PermutationA_length {elt} `{Setoid elt} : Proper (PermutationA equiv ==> Logic.eq) (@length elt).
Proof using . clear. intros l1 l2 perm. induction perm; simpl; auto; congruence. Qed.
-Instance Subset_m `{HF : @FSetSpecs A St HA F} :
+Global Instance Subset_m `{HF : @FSetSpecs A St HA F} :
Proper (equiv ==> equiv ==> iff) Subset.
Proof using .
unfold Subset; intros s s' H u u' H'; split; intros.
@@ -399,7 +402,7 @@ Proof using .
rewrite H'; apply H0; rewrite <- H; assumption.
Qed.
-Instance subset_m `{HF : @FSetSpecs A St HA F} :
+Global Instance subset_m `{HF : @FSetSpecs A St HA F} :
Proper (equiv ==> equiv ==> @eq bool) subset.
Proof using .
intros s s' H s'' s''' H0.
@@ -409,7 +412,7 @@ Proof using .
rewrite H in H1; rewrite H0 in H1; intuition.
Qed.
-Instance equal_m `{HF : @FSetSpecs A St HA F} :
+Global Instance equal_m `{HF : @FSetSpecs A St HA F} :
Proper (equiv ==> equiv ==> @eq bool) equal.
Proof using .
intros s s' H s'' s''' H0.
@@ -428,55 +431,55 @@ Lemma Subset_trans `{HF : @FSetSpecs A St HA F} :
forall s s' s'', s[<=]s'->s'[<=]s''->s[<=]s''.
Proof using . unfold Subset; eauto. Qed.
-Instance SubsetSetoid `{@FSetSpecs A St HA F} :
+Global Instance SubsetSetoid `{@FSetSpecs A St HA F} :
PreOrder Subset := {
PreOrder_Reflexive := Subset_refl;
PreOrder_Transitive := Subset_trans
}.
(** * Set operations and morphisms *)
-Instance In_s_m `{F : FSet A, @FSetSpecs _ _ _ F} :
+Global Instance In_s_m `{F : FSet A, @FSetSpecs _ _ _ F} :
Proper (equiv ==> Subset ++> impl) In | 1.
Proof using .
simpl_relation; apply H2; rewrite <- H1; auto.
Qed.
-Instance Empty_s_m `{F : FSet A, @FSetSpecs _ _ _ F} :
+Global Instance Empty_s_m `{F : FSet A, @FSetSpecs _ _ _ F} :
Proper (Subset --> impl) Empty.
Proof using .
simpl_relation; unfold Subset, Empty, impl; intros.
exact (H2 a (H1 a H3)).
Qed.
-Instance add_s_m `{F : FSet A, @FSetSpecs _ _ _ F} :
+Global Instance add_s_m `{F : FSet A, @FSetSpecs _ _ _ F} :
Proper (equiv ==> Subset ++> Subset) add.
Proof using .
unfold Subset; intros x y H1 s s' H2 a.
do 2 rewrite add_spec; rewrite H1; intuition.
Qed.
-Instance remove_s_m `{F : FSet A, @FSetSpecs _ _ _ F} :
+Global Instance remove_s_m `{F : FSet A, @FSetSpecs _ _ _ F} :
Proper (equiv ==> Subset ++> Subset) remove.
Proof using .
unfold Subset; intros x y H1 s s' H2 a.
do 2 rewrite remove_spec; rewrite H1; intuition.
Qed.
-Instance union_s_m `{F : FSet A, @FSetSpecs _ _ _ F} :
+Global Instance union_s_m `{F : FSet A, @FSetSpecs _ _ _ F} :
Proper (Subset ++> Subset ++> Subset) union.
Proof using .
intros s s' H1 s'' s''' H2 a.
do 2 rewrite union_spec; intuition.
Qed.
-Instance inter_s_m `{F : FSet A, @FSetSpecs _ _ _ F} :
+Global Instance inter_s_m `{F : FSet A, @FSetSpecs _ _ _ F} :
Proper (Subset ++> Subset ++> Subset) inter.
Proof using .
intros s s' H1 s'' s''' H2 a.
do 2 rewrite inter_spec; intuition.
Qed.
-Instance diff_s_m `{F : FSet A, @FSetSpecs _ _ _ F} :
+Global Instance diff_s_m `{F : FSet A, @FSetSpecs _ _ _ F} :
Proper (Subset ++> Subset --> Subset) diff.
Proof using .
unfold Subset; intros s s' H1 s'' s''' H2 a.
@@ -485,7 +488,7 @@ Qed.
(** [fold], [filter], [for_all], [exists_] and [partition] require
the additional hypothesis on [f]. *)
-Instance filter_m `{F : FSet A, @FSetSpecs _ _ _ F} :
+Global Instance filter_m `{F : FSet A, @FSetSpecs _ _ _ F} :
forall f `{Proper _ (equiv ==> @eq bool) f},
Proper (equiv ==> equiv) (filter f).
Proof using .
@@ -502,7 +505,7 @@ Proof using .
red; repeat intro; rewrite <- 2 Hff'; auto.
Qed.
-Instance filter_s_m `{F : FSet A, @FSetSpecs _ _ _ F} :
+Global Instance filter_s_m `{F : FSet A, @FSetSpecs _ _ _ F} :
forall f `{Proper _ (equiv ==> @eq bool) f},
Proper (Subset ==> Subset) (filter f).
Proof using .
@@ -680,7 +683,7 @@ Defined.
(** * Map **)
-Instance fold_compat {A B} `{FSetSpecs A} `{Setoid B} :
+Global Instance fold_compat {A B} `{FSetSpecs A} `{Setoid B} :
forall f : A -> B -> B, Proper (equiv ==> equiv ==> equiv) f -> transpose equiv f ->
forall a, Proper (equiv ==> equiv) (fun x => fold f x a).
Proof using .
@@ -704,11 +707,11 @@ intros f Hf x l. induction l as [| e l]; intro acc; simpl.
do 2 left. match goal with H : _ == e |- _ => now rewrite <- H end.
Qed.
-(* Instance elements_compat : Proper (equiv ==> PermutationA equiv) elements := elements_compat. *)
+(* Global Instance elements_compat : Proper (equiv ==> PermutationA equiv) elements := elements_compat. *)
Definition map {A B} `{FSet A} `{FSet B} (f : A -> B) s :=
fold (fun x acc => add (f x) acc) s empty.
-Instance map_compat {A B} `{FSetSpecs A} `{FSetSpecs B} : forall f : A -> B, Proper (equiv ==> equiv) f ->
+Global Instance map_compat {A B} `{FSetSpecs A} `{FSetSpecs B} : forall f : A -> B, Proper (equiv ==> equiv) f ->
Proper (equiv ==> equiv) (map f).
Proof using .
intros f Hf mâ‚ mâ‚‚ Hm. unfold map. apply fold_compat; autoclass; [|].
@@ -755,7 +758,7 @@ intros f Hf s. split; intros Hempty.
Qed.
Arguments map_empty_iff_empty {A} {B} {_} {_} {_} {_} {_} {_} {_} {_} f Hf s.
-Lemma map_injective_elements {A B} `{FSetSpecs A} `{FSetSpecs B} : forall f,
+Lemma map_injective_elements {A B} `{FSetSpecs A} `{FSetSpecs B} : forall f : A -> B,
Proper (equiv ==> equiv) f ->
injective equiv equiv f ->
forall s, PermutationA equiv (elements (map f s)) (List.map f (elements s)).
diff --git a/Util/FSets/FSetInterface.v b/Util/FSets/FSetInterface.v
index 758c0ba555393cc851c3db7635e705a8f00dc2b0..0e5c1106efa3524a477d28d12645e92c7b46d223 100644
--- a/Util/FSets/FSetInterface.v
+++ b/Util/FSets/FSetInterface.v
@@ -94,7 +94,7 @@ Class FSet `{EqDec elt} := {
SpecificOrderedType _ (Equal_pw set elt In) *)
}.
-Arguments set elt%type_scope {_} {_} {FSet}.
+Arguments set elt%_type_scope {_} {_} {FSet}.
(** Set notations (see below) are interpreted in scope [set_scope],
delimited with elt [scope]. We bind it to the type [set] and to
@@ -102,25 +102,25 @@ Arguments set elt%type_scope {_} {_} {FSet}.
Declare Scope set_scope.
Delimit Scope set_scope with set.
Bind Scope set_scope with set.
-Global Arguments In {_%type_scope} {_} {_} {_} _ _%set_scope.
-Global Arguments is_empty {_%type_scope} {_} {_} {_} _%set_scope.
-Global Arguments mem {_%type_scope} {_} {_} {_} _ _%set_scope.
-Global Arguments add {_%type_scope} {_} {_} {_} _ _%set_scope.
-Global Arguments remove {_%type_scope} {_} {_} {_} _ _%set_scope.
-Global Arguments union {_%type_scope} {_} {_} {_} _%set_scope _%set_scope.
-Global Arguments inter {_%type_scope} {_} {_} {_} _%set_scope _%set_scope.
-Global Arguments diff {_%type_scope} {_} {_} {_} _%set_scope _%set_scope.
-Global Arguments equal {_%type_scope} {_} {_} {_} _%set_scope _%set_scope.
-Global Arguments subset {_%type_scope} {_} {_} {_} _%set_scope _%set_scope.
-Global Arguments fold {_%type_scope} {_} {_} {_} {_} _ _%set_scope _.
-Global Arguments for_all {_%type_scope} {_} {_} {_} _ _%set_scope.
-Global Arguments exists_ {_%type_scope} {_} {_} {_} _ _%set_scope.
-Global Arguments filter {_%type_scope} {_} {_} {_} _ _%set_scope.
-Global Arguments partition {_%type_scope} {_} {_} {_} _ _%set_scope.
-Global Arguments cardinal {_%type_scope} {_} {_} {_} _%set_scope.
-Global Arguments elements {_%type_scope} {_} {_} {_} _%set_scope.
-Global Arguments choose {_%type_scope} {_} {_} {_} _%set_scope.
-(* Global Arguments min_elt {_%type_scope} {_} {_} {_} _%set_scope. *)
+Global Arguments In {_%_type_scope} {_} {_} {_} _ _%_set_scope.
+Global Arguments is_empty {_%_type_scope} {_} {_} {_} _%_set_scope.
+Global Arguments mem {_%_type_scope} {_} {_} {_} _ _%_set_scope.
+Global Arguments add {_%_type_scope} {_} {_} {_} _ _%_set_scope.
+Global Arguments remove {_%_type_scope} {_} {_} {_} _ _%_set_scope.
+Global Arguments union {_%_type_scope} {_} {_} {_} _%_set_scope _%_set_scope.
+Global Arguments inter {_%_type_scope} {_} {_} {_} _%_set_scope _%_set_scope.
+Global Arguments diff {_%_type_scope} {_} {_} {_} _%_set_scope _%_set_scope.
+Global Arguments equal {_%_type_scope} {_} {_} {_} _%_set_scope _%_set_scope.
+Global Arguments subset {_%_type_scope} {_} {_} {_} _%_set_scope _%_set_scope.
+Global Arguments fold {_%_type_scope} {_} {_} {_} {_} _ _%_set_scope _.
+Global Arguments for_all {_%_type_scope} {_} {_} {_} _ _%_set_scope.
+Global Arguments exists_ {_%_type_scope} {_} {_} {_} _ _%_set_scope.
+Global Arguments filter {_%_type_scope} {_} {_} {_} _ _%_set_scope.
+Global Arguments partition {_%_type_scope} {_} {_} {_} _ _%_set_scope.
+Global Arguments cardinal {_%_type_scope} {_} {_} {_} _%_set_scope.
+Global Arguments elements {_%_type_scope} {_} {_} {_} _%_set_scope.
+Global Arguments choose {_%_type_scope} {_} {_} {_} _%_set_scope.
+(* Global Arguments min_elt {_%_type_scope} {_} {_} {_} _%_set_scope. *)
(* Global Arguments max_elt {_%type_scope} {_} {_} {_} _%set_scope. *)
(** All projections should be made opaque for tactics using [delta]-conversion,
@@ -298,28 +298,28 @@ Class FSetSpecs_max_elt `(FSet A) := {
}.*)
Class FSetSpecs `(F : FSet A) := {
- FFSetSpecs_In :> FSetSpecs_In F;
- FFSetSpecs_mem :> FSetSpecs_mem F;
- FFSetSpecs_equal :> FSetSpecs_equal F;
- FFSetSpecs_subset :> FSetSpecs_subset F;
- FFSetSpecs_empty :> FSetSpecs_empty F;
- FFSetSpecs_is_empty :> FSetSpecs_is_empty F;
- FFSetSpecs_add :> FSetSpecs_add F;
- FFSetSpecs_remove :> FSetSpecs_remove F;
- FFSetSpecs_singleton :> FSetSpecs_singleton F;
- FFSetSpecs_union :> FSetSpecs_union F;
- FFSetSpecs_inter :> FSetSpecs_inter F;
- FFSetSpecs_diff :> FSetSpecs_diff F;
- FFSetSpecs_fold :> FSetSpecs_fold F;
- FFSetSpecs_cardinal :> FSetSpecs_cardinal F;
- FFSetSpecs_filter :> FSetSpecs_filter F;
- FFSetSpecs_for_all :> FSetSpecs_for_all F;
- FFSetSpecs_exists :> FSetSpecs_exists F;
- FFSetSpecs_partition :> FSetSpecs_partition F;
- FFSetSpecs_elements :> FSetSpecs_elements F;
- FFSetSpecs_choose :> FSetSpecs_choose F;
- (* FFSetSpecs_min_elt :> FSetSpecs_min_elt F; *)
- (* FFSetSpecs_max_elt :> FSetSpecs_max_elt F *)
+ #[global] FFSetSpecs_In :: FSetSpecs_In F;
+ #[global] FFSetSpecs_mem :: FSetSpecs_mem F;
+ #[global] FFSetSpecs_equal :: FSetSpecs_equal F;
+ FFSetSpecs_subset :: FSetSpecs_subset F;
+ #[global] FFSetSpecs_empty :: FSetSpecs_empty F;
+ #[global] FFSetSpecs_is_empty :: FSetSpecs_is_empty F;
+ #[global] FFSetSpecs_add :: FSetSpecs_add F;
+ #[global] FFSetSpecs_remove :: FSetSpecs_remove F;
+ #[global] FFSetSpecs_singleton :: FSetSpecs_singleton F;
+ #[global] FFSetSpecs_union :: FSetSpecs_union F;
+ #[global] FFSetSpecs_inter :: FSetSpecs_inter F;
+ #[global] FFSetSpecs_diff :: FSetSpecs_diff F;
+ #[global] FFSetSpecs_fold :: FSetSpecs_fold F;
+ #[global] FFSetSpecs_cardinal :: FSetSpecs_cardinal F;
+ #[global] FFSetSpecs_filter :: FSetSpecs_filter F;
+ #[global] FFSetSpecs_for_all :: FSetSpecs_for_all F;
+ #[global] FFSetSpecs_exists :: FSetSpecs_exists F;
+ #[global] FFSetSpecs_partition :: FSetSpecs_partition F;
+ #[global] FFSetSpecs_elements :: FSetSpecs_elements F;
+ #[global] FFSetSpecs_choose :: FSetSpecs_choose F;
+ (* #[global] FFSetSpecs_min_elt :: FSetSpecs_min_elt F; *)
+ (* #[global]FFSetSpecs_max_elt :: FSetSpecs_max_elt F *)
}.
(* About FSetSpecs. *)
diff --git a/Util/FSets/FSetList.v b/Util/FSets/FSetList.v
index 4405d949414dc3bd406adb1567d07f7911f4c48d..e1b5f083a08b0b985bdc79549ba6f97cc5981b3b 100644
--- a/Util/FSets/FSetList.v
+++ b/Util/FSets/FSetList.v
@@ -6,7 +6,8 @@ Require Import SetoidDec.
Require Pactole.Util.Coqlib.
Require Import Pactole.Util.FSets.FSetInterface.
-
+(* this will become non default soon. *)
+Ltac Tauto.intuition_solver ::= auto with *.
Set Implicit Arguments.
Open Scope signature_scope.
@@ -257,9 +258,9 @@ Lemma list_add_3 : forall (m : t elt) x y e e',
x =/= y -> InA (equiv@@1) (y, e) (list_add x e' m) -> InA (equiv@@1) (y, e) m.
Proof.
intros m x y e e' Hxy Hy. simpl. induction m as [| [z p] l].
-+ inversion_clear Hy; try inversion H0. now elim Hxy.
++ inversion_clear Hy; try inversion H0. now contradiction Hxy.
+ simpl in *. destruct (equiv_dec x z).
- - right. inversion_clear Hy; trivial. now elim Hxy.
+ - right. inversion_clear Hy; trivial. now contradiction Hxy.
- inversion_clear Hy; now left + (right; apply IHl).
Qed.*)
@@ -320,7 +321,7 @@ Arguments elements {_%type_scope} {_} _%set_scope.
Arguments choose {_%type_scope} {_} _%set_scope.
*)
(** The full set of operations. *)
-Instance SetList elt `{EqDec elt} : FSet := {|
+Global Instance SetList elt `{EqDec elt} : FSet := {|
set := sig (@NoDupA elt equiv);
In := fun x s => InA equiv x (proj1_sig s);
empty := exist _ nil (NoDupA_nil equiv);
@@ -350,7 +351,7 @@ Instance SetList elt `{EqDec elt} : FSet := {|
(** ** Proofs of the specifications **)
(*
-Instance MapListFacts_MapsTo key `{EqDec key} : FMapSpecs_MapsTo (MapList _).
+Global Instance MapListFacts_MapsTo key `{EqDec key} : FMapSpecs_MapsTo (MapList _).
Proof.
split. intros elt [m Hm] x y e Hxy Hx. simpl in *.
induction m; inversion_clear Hx.
@@ -358,10 +359,10 @@ induction m; inversion_clear Hx.
- right. inversion_clear Hm. now apply IHm.
Qed.
-Instance MapListFacts_mem key `{EqDec key} : FMapSpecs_mem (MapList _).
+Global Instance MapListFacts_mem key `{EqDec key} : FMapSpecs_mem (MapList _).
Proof. split.
* intros elt [m Hm] x [e Hin]. simpl in *. induction m as [| [y n] l]; inversion_clear Hin.
- + simpl. destruct (equiv_dec x y) as [Hxy | Hxy]; trivial. elim Hxy. now destruct H0.
+ + simpl. destruct (equiv_dec x y) as [Hxy | Hxy]; trivial. contradiction Hxy. now destruct H0.
+ simpl. destruct (equiv_dec x y) as [Hxy | Hxy]; trivial. inversion_clear Hm. auto.
* intros elt [m Hm] x Hmem. unfold In. simpl in *. induction m as [| [y n] l]; simpl in Hmem.
+ discriminate.
@@ -370,13 +371,13 @@ Proof. split.
- inversion_clear Hm. apply IHl in Hmem; trivial; []. destruct Hmem as [e ?]. exists e. now right.
Qed.
-Instance MapListFacts_empty key `{EqDec key} : FMapSpecs_empty (MapList _).
+Global Instance MapListFacts_empty key `{EqDec key} : FMapSpecs_empty (MapList _).
Proof. split. intros elt x e Hin. inversion Hin. Qed.
-Instance MapListFacts_is_empty key `{EqDec key} : FMapSpecs_is_empty (MapList _).
+Global Instance MapListFacts_is_empty key `{EqDec key} : FMapSpecs_is_empty (MapList _).
Proof. split.
* intros elt [m Hm] Hm'. destruct m as [| [x n] l]; trivial.
- elim Hm' with x n. now left.
+ contradiction Hm' with x n. now left.
* intros elt [m Hm] Hm'. destruct m as [| [x n] l]; try discriminate.
intros x n Hin. inversion Hin.
Qed.
@@ -387,7 +388,7 @@ Local Transparent
union inter diff equal subset fold
for_all exists_ filter partition cardinal elements choose.
-Instance SetListFacts_In elt `{EqDec elt} : FSetSpecs_In SetList.
+Global Instance SetListFacts_In elt `{EqDec elt} : FSetSpecs_In SetList.
Proof using . split. simpl. intros s x y Heq. now rewrite Heq. Qed.
Local Lemma mem_aux elt `{EqDec elt} : forall x l, list_mem x l = true <-> InA equiv x l.
@@ -401,16 +402,16 @@ intros x l. induction l as [| e l]; simpl.
- inversion_clear Hin; assumption || contradiction.
Qed.
-Instance SetListFacts_mem elt `{EqDec elt} : FSetSpecs_mem SetList.
+Global Instance SetListFacts_mem elt `{EqDec elt} : FSetSpecs_mem SetList.
Proof using . split.
* intros [s Hs] x Hin. simpl in *. now rewrite mem_aux.
* intros [s Hs] x Hin. simpl in *. now rewrite mem_aux in Hin.
Qed.
-Instance SetLIst_Facts_empty elt `{EqDec elt} : FSetSpecs_empty SetList.
+Global Instance SetLIst_Facts_empty elt `{EqDec elt} : FSetSpecs_empty SetList.
Proof using . split. intros x Hin; simpl in *. now rewrite InA_nil in Hin. Qed.
-Instance SetListFacts_is_empty elt `{EqDec elt} : FSetSpecs_is_empty SetList.
+Global Instance SetListFacts_is_empty elt `{EqDec elt} : FSetSpecs_is_empty SetList.
Proof using . split.
* intros [[| e s] Hs] Hempty; simpl in *.
+ reflexivity.
@@ -434,7 +435,7 @@ destruct (list_mem e l) eqn:Hmem.
- destruct Hin; now left + right.
Qed.
-Instance SetListFacts_add elt `{EqDec elt} : FSetSpecs_add SetList.
+Global Instance SetListFacts_add elt `{EqDec elt} : FSetSpecs_add SetList.
Proof using . split.
* intros [s Hs] x y Heq. simpl. rewrite add_aux. now left.
* intros [s Hs] x y Hin. simpl in *. rewrite add_aux. now right.
@@ -460,14 +461,14 @@ intros x e l Hnodup. induction l as [| e' l]; simpl.
- destruct Hin as [[] ?]; now left + right.
Qed.
-Instance SetListFacts_remove elt `{EqDec elt} : FSetSpecs_remove SetList.
+Global Instance SetListFacts_remove elt `{EqDec elt} : FSetSpecs_remove SetList.
Proof using . split.
* intros [s Hs] x y Heq. simpl. symmetry in Heq. now rewrite remove_aux.
* intros [s Hs] x y Hxy Hin. simpl in *. now rewrite remove_aux.
* intros [s Hs] x y Hin. simpl in *. now rewrite remove_aux in Hin.
Qed.
-Instance SetListFacts_singleton elt `{EqDec elt} : FSetSpecs_singleton SetList.
+Global Instance SetListFacts_singleton elt `{EqDec elt} : FSetSpecs_singleton SetList.
Proof using . split.
* intros x y Hin. simpl in *. unfold list_add in Hin.
destruct (list_mem x nil); now inversion_clear Hin.
@@ -484,7 +485,7 @@ intros s1. induction s1 as [| e1 s1]; simpl; intros s2 x Hin.
unfold list_add. now destruct (list_mem e1 s2); try right.
Qed.
-Instance SetListFacts_union elt `{EqDec elt} : FSetSpecs_union SetList.
+Global Instance SetListFacts_union elt `{EqDec elt} : FSetSpecs_union SetList.
Proof using . split.
* intros [s1 Hs1] [s2 Hs2]. simpl.
unfold list_union, list_fold, flip.
@@ -542,7 +543,7 @@ destruct (x == e), (y == e).
- apply IHl.
Qed.
-Instance SetListFacts_inter elt `{EqDec elt} : FSetSpecs_inter SetList.
+Global Instance SetListFacts_inter elt `{EqDec elt} : FSetSpecs_inter SetList.
Proof using . split.
* intros [s1 Hs1] [s2 Hs2] x. simpl.
unfold list_inter, list_fold, flip. rewrite inter_aux.
@@ -569,14 +570,14 @@ intros l1 l2 x. revert l1. induction l2 as [| e2 l2]; simpl; intros l1 Hnodup.
+ now apply t_remove_lemma.
Qed.
-Instance SetListFacts_diff elt `{EqDec elt} : FSetSpecs_diff SetList.
+Global Instance SetListFacts_diff elt `{EqDec elt} : FSetSpecs_diff SetList.
Proof using .
split;
intros [s1 Hs1] [s2 Hs2] x; simpl;
unfold list_diff, list_fold, flip; now rewrite diff_aux.
Qed.
-Instance SetListFacts_subset elt `{EqDec elt} : FSetSpecs_subset SetList.
+Global Instance SetListFacts_subset elt `{EqDec elt} : FSetSpecs_subset SetList.
Proof using . split.
* intros s1 s2 Hle. simpl. unfold list_subset.
change (is_empty (diff s1 s2) = true).
@@ -588,11 +589,11 @@ Proof using . split.
apply is_empty_2 in Hle. intros x Hin. specialize (Hle x).
destruct (mem x s2) eqn:Hmem.
+ now apply mem_2.
- + elim Hle. apply diff_3; trivial; [].
+ + contradiction Hle. apply diff_3; trivial; [].
intro Habs. apply mem_1 in Habs. congruence.
Qed.
-Instance SetListFacts_equal elt `{EqDec elt} : FSetSpecs_equal SetList.
+Global Instance SetListFacts_equal elt `{EqDec elt} : FSetSpecs_equal SetList.
Proof using . split.
* intros s1 s2 Heq. simpl.
change (subset s1 s2 && subset s2 s1 = true).
@@ -605,13 +606,13 @@ Proof using . split.
split; now apply subset_2.
Qed.
-Instance SetListFacts_cardinal elt `{EqDec elt} : FSetSpecs_cardinal SetList.
+Global Instance SetListFacts_cardinal elt `{EqDec elt} : FSetSpecs_cardinal SetList.
Proof using . split. reflexivity. Qed.
-Instance SetListFacts_fold elt `{EqDec elt} : FSetSpecs_fold SetList.
+Global Instance SetListFacts_fold elt `{EqDec elt} : FSetSpecs_fold SetList.
Proof using . split. reflexivity. Qed.
-Instance SetListFacts_filter elt `{EqDec elt} : FSetSpecs_filter SetList.
+Global Instance SetListFacts_filter elt `{EqDec elt} : FSetSpecs_filter SetList.
Proof using . split.
* intros [s Hs] x f Hf Hin.
induction s as [| e s]; simpl in *.
@@ -639,7 +640,7 @@ Proof using . split.
rewrite <- Hfe, <- Hfx. now apply Hf.
Qed.
-Instance SetListFacts_for_all elt `{EqDec elt} : FSetSpecs_for_all SetList.
+Global Instance SetListFacts_for_all elt `{EqDec elt} : FSetSpecs_for_all SetList.
Proof using . split.
* intros [s Hs] f Hf Hall. unfold For_all in Hall. simpl in *.
rewrite forallb_forall. intros x Hin. apply Hall. apply In_InA; Preliminary.autoclass.
@@ -649,7 +650,7 @@ Proof using . split.
rewrite Heq. auto.
Qed.
-Instance SetListFacts_exists elt `{EqDec elt} : FSetSpecs_exists SetList.
+Global Instance SetListFacts_exists elt `{EqDec elt} : FSetSpecs_exists SetList.
Proof using . split.
* intros [s Hs] f Hf [x [Hin Hfx]]. simpl in *. rewrite existsb_exists.
rewrite InA_alt in Hin. destruct Hin as [y [Heq Hin]].
@@ -658,7 +659,7 @@ Proof using . split.
destruct Hex as [x [Hin Hfx]]. exists x. simpl. split; trivial; []. apply In_InA; Preliminary.autoclass.
Qed.
-Instance SetListFacts_partition elt `{EqDec elt} : FSetSpecs_partition SetList.
+Global Instance SetListFacts_partition elt `{EqDec elt} : FSetSpecs_partition SetList.
Proof using . split.
* intros [s Hs] f Hf x. simpl. induction s as [| e s]; simpl.
+ reflexivity.
@@ -678,14 +679,14 @@ Proof using . split.
(progress rewrite IHs in * || rewrite <- IHs in *); auto.
Qed.
-Instance SetListFacts_elements elt `{EqDec elt} : FSetSpecs_elements SetList.
+Global Instance SetListFacts_elements elt `{EqDec elt} : FSetSpecs_elements SetList.
Proof using . split.
* simpl. auto.
* simpl. auto.
* intros [s Hs]. simpl. assumption.
Qed.
-Instance SetListFacts_choose elt `{EqDec elt} : FSetSpecs_choose SetList.
+Global Instance SetListFacts_choose elt `{EqDec elt} : FSetSpecs_choose SetList.
Proof using . split.
* intros [[| e s] Hs] x Hin; simpl in *.
+ discriminate.
@@ -697,5 +698,5 @@ Qed.
(** The full set of specifications. *)
-Instance SetListFacts elt `{EqDec elt} : FSetSpecs SetList.
+Global Instance SetListFacts elt `{EqDec elt} : FSetSpecs SetList.
Proof using . split; auto with typeclass_instances. Qed.
diff --git a/Util/FSets/OrderedType.v b/Util/FSets/OrderedType.v
index 2dfbc12a7ed272a2b89d8d0ffd3347bc0cc849ad..fc271f16a98c06ad5d344ab4542a94a3c072757f 100644
--- a/Util/FSets/OrderedType.v
+++ b/Util/FSets/OrderedType.v
@@ -310,9 +310,9 @@ Ltac normalize_notations :=
end.
Ltac abstraction := match goal with
- | H : False |- _ => elim H
- | H : ?x <<< ?x |- _ => elim (lt_antirefl H)
- | H : ?x =/= ?x |- _ => elim (H (reflexivity x))
+ | H : False |- _ => contradiction H
+ | H : ?x <<< ?x |- _ => contradiction (lt_antirefl H)
+ | H : ?x =/= ?x |- _ => contradiction (H (reflexivity x))
| H : ?x === ?x |- _ => clear H; abstraction
| H : ~?x <<< ?x |- _ => clear H; abstraction
| |- ?x === ?x => reflexivity
@@ -703,7 +703,7 @@ Section KeyOrderedType.
Proof using .
intros; red; intros.
destruct H1 as [e' H2].
- elim (@ltk_not_eqk (k,e) (k,e')).
+ contradiction (@ltk_not_eqk (k,e) (k,e')).
eapply Sort_Inf_In; eauto.
red; simpl; auto.
Qed.
diff --git a/Util/Fin.v b/Util/Fin.v
new file mode 100644
index 0000000000000000000000000000000000000000..f73465d01bdcfa392d2bfe49bfafadb8ffbecd68
--- /dev/null
+++ b/Util/Fin.v
@@ -0,0 +1,1734 @@
+Require Import Utf8 Arith RelationPairs SetoidDec.
+Require Import Lia.
+Require Import Pactole.Util.Preliminary.
+Require Import Pactole.Util.SetoidDefs.
+Require Import Pactole.Util.NumberComplements.
+Require Import Pactole.Util.Bijection.
+Set Implicit Arguments.
+Unset Strict Implicit.
+Unset Printing Implicit Defensive.
+
+(*
+ *
+ * The type fin u with u any nat ≠0
+ * consisting of the nats smaller than u
+ *
+ *)
+
+Section Fin.
+
+Context (u : nat).
+
+Inductive fin : Type := Fin : ∀ j : nat, j < u -> fin.
+
+Global Instance fin_Setoid : Setoid fin := eq_setoid fin.
+
+Lemma fin_dec : ∀ f1 f2 : fin, {f1 = f2} + {f1 <> f2}.
+Proof using .
+ intros [j1 H1] [j2 H2]. destruct (Nat.eq_dec j1 j2).
+ - subst. left. f_equal. apply le_unique.
+ - right. intro Habs. inv Habs. auto.
+Qed.
+
+Global Instance fin_EqDec : EqDec fin_Setoid := fin_dec.
+
+Global Coercion fin2nat (f : fin) : nat := match f with @Fin m _ => m end.
+
+Definition fin2nat_compat : Proper (equiv ==> equiv) fin2nat := _.
+
+Lemma fin_lt : ∀ f : fin, f < u.
+Proof using . intros. destruct f as [j p]. exact p. Qed.
+
+Lemma fin_le : ∀ f : fin, f <= Nat.pred u.
+Proof using . intros. apply Nat.lt_le_pred, fin_lt. Qed.
+
+Lemma fin_between : ∀ f : fin, 0 <= f < u.
+Proof using . intros. split. apply Nat.le_0_l. apply fin_lt. Qed.
+
+Lemma fin2natI : Preliminary.injective equiv equiv fin2nat.
+Proof using .
+ intros [j1 H1] [j2 H2] Heq. cbn in Heq. subst. cbn. f_equal. apply le_unique.
+Qed.
+
+Lemma lt_gt_cases : ∀ f1 f2 : fin, f1 ≠f2 <-> f1 < f2 ∨ f2 < f1.
+Proof using .
+ intros. erewrite not_iff_compat. apply Nat.lt_gt_cases.
+ symmetry. apply (injective_eq_iff fin2natI).
+Qed.
+
+Lemma le_lt_eq_dec : ∀ f1 f2 : fin, f1 <= f2 -> {f1 < f2} + {f1 = f2}.
+Proof using .
+ intros * H. destruct (le_lt_eq_dec f1 f2 H) as [Hd | Hd].
+ left. apply Hd. right. apply fin2natI, Hd.
+Qed.
+
+Lemma lt_eq_lt_dec : ∀ f1 f2 : fin, {f1 < f2} + {f1 = f2} + {f2 < f1}.
+Proof using .
+ intros. destruct (lt_eq_lt_dec f1 f2) as [[Hd | Hd] | Hd].
+ left. left. apply Hd. left. right. apply fin2natI, Hd. right. apply Hd.
+Qed.
+
+End Fin.
+
+Section mod2fin.
+
+Context {l u : nat} {ltc_l_u : l <c u}.
+
+(*
+ *
+ * The fin u whose underlying nat is 0
+ *
+ *)
+
+Definition fin0 : fin u := Fin lt_0_u.
+
+Lemma fin02nat : fin0 = 0 :> nat.
+Proof using . reflexivity. Qed.
+
+Lemma all_fin0 : ∀ f : fin u, u = 1 -> f = fin0.
+Proof using .
+ intros f H. apply fin2natI. rewrite fin02nat. subst.
+ pose proof (fin_lt f) as H. inversion H as [H0 | n H0 H1].
+ apply H0. inversion H0.
+Qed.
+
+Lemma all_eq : ∀ f1 f2 : fin u, u = 1 -> f1 = f2.
+Proof using ltc_l_u.
+ intros * H. rewrite (all_fin0 f1), (all_fin0 f2). reflexivity. all: apply H.
+Qed.
+
+Lemma fin0_le : ∀ f : fin u, fin0 <= f.
+Proof using . intros. rewrite fin02nat. apply Nat.le_0_l. Qed.
+
+Lemma neq_fin0_lt_fin0 : ∀ f : fin u, f ≠fin0 <-> fin0 < f.
+Proof using .
+ intros. rewrite <- Nat.neq_0_lt_0, <- fin02nat. symmetry.
+ apply not_iff_compat, injective_eq_iff, fin2natI.
+Qed.
+
+Lemma eq_fin0_lt_dec : ∀ f : fin u, {f = fin0} + {fin0 < f}.
+Proof using .
+ intros. destruct (eq_0_lt_dec f) as [Hd | Hd].
+ left. apply fin2natI, Hd. right. apply Hd.
+Qed.
+
+Lemma le_fin0 : ∀ f : fin u, f <= fin0 <-> f = fin0.
+Proof using .
+ intros. rewrite fin02nat, Nat.le_0_r, <- fin02nat.
+ apply injective_eq_iff, fin2natI.
+Qed.
+
+Lemma lt_fin0 : ∀ f1 f2 : fin u, f1 < f2 -> fin0 < f2.
+Proof using . intros * H. eapply Nat.lt_lt_0, H. Qed.
+
+(*
+ *
+ * The fin u whose underlying nat is Nat.pred u
+ *
+ *)
+
+Definition fin_max : fin u := Fin lt_pred_u.
+
+Lemma fin_max2nat : fin_max = Nat.pred u :> nat.
+Proof using . reflexivity. Qed.
+
+Lemma le_max : ∀ f : fin u, f <= fin_max.
+Proof using .
+ intros. apply Nat.lt_succ_r. rewrite fin_max2nat, S_pred_u. apply fin_lt.
+Qed.
+
+Lemma max_le : ∀ f : fin u, fin_max <= f <-> f = fin_max.
+Proof using .
+ intros. rewrite Nat.le_lteq, Nat.lt_nge. etransitivity. split.
+ - intros [H | H]. contradict H. apply le_max. apply H.
+ - intros H. right. apply H.
+ - rewrite Nat.eq_sym_iff. apply injective_eq_iff, fin2natI.
+Qed.
+
+Lemma neq_max_lt_max : ∀ f : fin u, f ≠fin_max <-> f < fin_max.
+Proof using . intros. rewrite <- max_le. apply Nat.nle_gt. Qed.
+
+Lemma eq_max_lt_dec : ∀ f : fin u, {f = fin_max} + {f < fin_max}.
+Proof using .
+ intros. destruct (fin_dec f fin_max) as [Hd | Hd].
+ left. apply Hd. right. apply neq_max_lt_max, Hd.
+Qed.
+
+Lemma max_lt : ∀ f1 f2 : fin u, f2 < f1 -> f2 < fin_max.
+Proof using .
+ intros * H. rewrite Nat.lt_nge, max_le. intros Ha.
+ subst. eapply Nat.lt_nge. apply H. apply le_max.
+Qed.
+
+(*
+ *
+ * Building the fin u whose underlying nat
+ * is j mod u with j the input of the function
+ *
+ *)
+
+Lemma mod2fin_lt : ∀ j : nat, j mod u < u.
+Proof using ltc_l_u. intros. apply Nat.mod_upper_bound, neq_u_0. Qed.
+
+Lemma mod2fin_le : ∀ j : nat, j mod u <= Nat.pred u.
+Proof using ltc_l_u. intros. apply Nat.lt_le_pred, mod2fin_lt. Qed.
+
+Definition mod2fin (j : nat) : fin u := Fin (mod2fin_lt j).
+
+Definition mod2fin_compat : Proper (equiv ==> equiv) mod2fin := _.
+
+Lemma mod2fin2nat : ∀ j : nat, mod2fin j = j mod u :> nat.
+Proof using . intros. reflexivity. Qed.
+
+Lemma mod2fin_mod : ∀ j : nat, mod2fin (j mod u) = mod2fin j.
+Proof using .
+ intros. apply fin2natI. rewrite 2 mod2fin2nat. apply Nat.Div0.mod_mod.
+Qed.
+
+Lemma mod2fin_mod2fin : ∀ j : nat, mod2fin (mod2fin j) = mod2fin j.
+Proof using . intros. rewrite mod2fin2nat. apply mod2fin_mod. Qed.
+
+Lemma mod2finK : ∀ f : fin u, mod2fin f = f.
+Proof using . intros. apply fin2natI, Nat.mod_small, fin_lt. Qed.
+
+Lemma mod2fin_small : ∀ j : nat, j < u -> mod2fin j = j :> nat.
+Proof using . intros * H. rewrite mod2fin2nat. apply Nat.mod_small, H. Qed.
+
+Lemma mod2fin_bounded_diffI : ∀ j1 j2 : nat, j1 <= j2
+ -> j2 - j1 < u -> mod2fin j1 = mod2fin j2 -> j1 = j2.
+Proof using .
+ intros * Hleq Hsub Heq. eapply mod_bounded_diffI. apply neq_u_0.
+ exact Hleq. exact Hsub. rewrite <-2 mod2fin2nat, Heq. reflexivity.
+Qed.
+
+Lemma mod2fin_betweenI : ∀ p j1 j2 : nat, p <= j1 < p + u
+ -> p <= j2 < p + u -> mod2fin j1 = mod2fin j2 -> j1 = j2.
+Proof using .
+ intros p. eapply (bounded_diff_between _
+ (inj_sym _ _ nat_Setoid (eq_setoid (fin u)) mod2fin)).
+ intros * H1 H2. apply mod2fin_bounded_diffI. all: assumption.
+Qed.
+
+Lemma mod2fin_muln : ∀ j : nat, mod2fin (u * j) = fin0.
+Proof using .
+ intros. apply fin2natI. rewrite mod2fin2nat, fin02nat, Nat.mul_comm.
+ apply Nat.Div0.mod_mul.
+Qed.
+
+Lemma mod2fin_le_between_compat : ∀ p j1 j2 : nat, u * p <= j1 < u * p + u
+ -> u * p <= j2 < u * p + u -> j1 <= j2 -> mod2fin j1 <= mod2fin j2.
+Proof using .
+ intros * Hb1 Hb2 Hle. rewrite 2 mod2fin2nat.
+ eapply mod_le_between_compat. all: eassumption.
+Qed.
+
+Lemma mod2fin_lt_between_compat : ∀ p j1 j2 : nat, u * p <= j1 < u * p + u
+ -> u * p <= j2 < u * p + u -> j1 < j2 -> mod2fin j1 < mod2fin j2.
+Proof using .
+ intros * Hb1 Hb2 Hlt. rewrite 2 mod2fin2nat.
+ eapply mod_lt_between_compat. all: eassumption.
+Qed.
+
+Lemma addn_mod2fin_idemp_l : ∀ j1 j2 : nat,
+ mod2fin (mod2fin j1 + j2) = mod2fin (j1 + j2).
+Proof using .
+ intros. apply fin2natI. rewrite 3 mod2fin2nat.
+ apply Nat.Div0.add_mod_idemp_l.
+Qed.
+
+Lemma addn_mod2fin_idemp_r : ∀ j1 j2 : nat,
+ mod2fin (j1 + mod2fin j2) = mod2fin (j1 + j2).
+Proof using .
+ intros. apply fin2natI. rewrite 3 mod2fin2nat.
+ apply Nat.Div0.add_mod_idemp_r.
+Qed.
+
+Lemma divide_fin0_mod2fin : ∀ j : nat, Nat.divide u j -> mod2fin j = fin0.
+Proof using .
+ intros * H. apply fin2natI. rewrite mod2fin2nat.
+ apply Nat.Lcm0.mod_divide, H.
+Qed.
+
+Lemma mod2fin0 : mod2fin 0 = fin0.
+Proof using . apply divide_fin0_mod2fin, Nat.divide_0_r. Qed.
+
+Lemma mod2fin_max : mod2fin (Nat.pred u) = fin_max.
+Proof using . apply fin2natI, mod2fin_small, fin_lt. Qed.
+
+Lemma mod2fin_u : mod2fin u = fin0.
+Proof using . apply divide_fin0_mod2fin, Nat.divide_refl. Qed.
+
+(*
+ *
+ * The successor of fin0
+ *
+ *)
+
+Definition fin1 : fin u := mod2fin 1.
+
+Lemma fin1E : fin1 = mod2fin 1.
+Proof using . reflexivity. Qed.
+
+Lemma fin12nat {ltc_1_u : 1 <c u} : fin1 = 1 :> nat.
+Proof using . rewrite fin1E. apply mod2fin_small, ltc_1_u. Qed.
+
+(*
+ *
+ * Adding either a nat (addm) or
+ * a fin u (addf) to a fin u
+ *
+ *)
+
+Definition addm (f : fin u) (j : nat) : fin u := mod2fin (f + j).
+
+Definition addm_compat : Proper (equiv ==> equiv ==> equiv) addm := _.
+
+Lemma addmE : ∀ (f : fin u) (j : nat), addm f j = mod2fin (f + j).
+Proof using . reflexivity. Qed.
+
+Lemma addm2nat : ∀ (f : fin u) (j : nat), addm f j = (f + j) mod u :> nat.
+Proof using . intros. rewrite addmE. apply mod2fin2nat. Qed.
+
+Lemma addm_mod : ∀ (f : fin u) (j : nat), addm f (j mod u) = addm f j.
+Proof using .
+ intros. rewrite 2 addmE, <- mod2fin2nat. apply addn_mod2fin_idemp_r.
+Qed.
+
+Lemma addm_mod2fin : ∀ (f : fin u) (j : nat), addm f (mod2fin j) = addm f j.
+Proof using . intros. rewrite mod2fin2nat. apply addm_mod. Qed.
+
+Definition addf (f1 f2 : fin u) : fin u := addm f1 f2.
+
+Definition addf_compat : Proper (equiv ==> equiv ==> equiv) addf := _.
+
+Lemma addfE : ∀ f1 f2 : fin u, addf f1 f2 = mod2fin (f1 + f2).
+Proof using . reflexivity. Qed.
+
+Lemma addf2nat : ∀ f1 f2 : fin u, addf f1 f2 = (f1 + f2) mod u :> nat.
+Proof using . intros. apply addm2nat. Qed.
+
+Lemma addf_addm : ∀ f1 f2 : fin u, addf f1 f2 = addm f1 f2.
+Proof using . reflexivity. Qed.
+
+Lemma addm_addf : ∀ (f : fin u) (j : nat), addm f j = addf f (mod2fin j).
+Proof using . intros. rewrite addf_addm. symmetry. apply addm_mod2fin. Qed.
+
+Lemma addfC : ∀ f1 f2 : fin u, addf f1 f2 = addf f2 f1.
+Proof using . intros. rewrite 2 addfE, Nat.add_comm. reflexivity. Qed.
+
+Lemma addmC : ∀ (f : fin u) (j : nat), addm f j = addm (mod2fin j) f.
+Proof using . intros. rewrite 2 addm_addf, mod2finK. apply addfC. Qed.
+
+Lemma addmA : ∀ (f1 f2 : fin u) (j : nat),
+ addm f1 (addm f2 j) = addm (addm f1 f2) j.
+Proof using .
+ intros. rewrite 4 addmE, addn_mod2fin_idemp_l,
+ addn_mod2fin_idemp_r, Nat.add_assoc. reflexivity.
+Qed.
+
+Lemma addfA : ∀ f1 f2 f3 : fin u,
+ addf f1 (addf f2 f3) = addf (addf f1 f2) f3.
+Proof using . intros. rewrite 2 (addf_addm _ f3). apply addmA. Qed.
+
+Lemma addmAC : ∀ (f : fin u) (j1 j2 : nat),
+ addm (addm f j1) j2 = addm (addm f j2) j1.
+Proof using .
+ intros. rewrite 4 addm_addf, <-2 addfA, (addfC (mod2fin _)). reflexivity.
+Qed.
+
+Lemma addfAC : ∀ f1 f2 f3 : fin u,
+ addf (addf f1 f2) f3 = addf (addf f1 f3) f2.
+Proof using . intros. rewrite 4 addf_addm. apply addmAC. Qed.
+
+Lemma addfCA : ∀ f1 f2 f3 : fin u,
+ addf f1 (addf f2 f3) = addf f2 (addf f1 f3).
+Proof using .
+ intros. rewrite (addfC f2 f3), addfA, (addfC (addf _ _) _). reflexivity.
+Qed.
+
+Lemma addmCA : ∀ (f1 f2 : fin u) (j : nat),
+ addm f1 (addm f2 j) = addm f2 (addm f1 j).
+Proof using .
+ intros. rewrite 2 (addm_addf _ j), <-2 addf_addm. apply addfCA.
+Qed.
+
+Lemma addfACA : ∀ f1 f2 f3 f4 : fin u,
+ addf (addf f1 f2) (addf f3 f4) = addf (addf f1 f3) (addf f2 f4).
+Proof using . intros. rewrite 2 addfA, (addfAC f1 f3 f2). reflexivity. Qed.
+
+Lemma addmACA : ∀ (f1 f2 f3 : fin u) (j : nat),
+ addm (addm f1 f2) (addm f3 j) = addm (addm f1 f3) (addm f2 j).
+Proof using .
+ intros. rewrite 2 (addm_addf _ j), <- 4 addf_addm. apply addfACA.
+Qed.
+
+Lemma addIm : ∀ j : nat,
+ Preliminary.injective equiv equiv (λ f : fin u, addm f j).
+Proof using .
+ intros * f1 f2 H. eapply fin2natI, (Nat.add_cancel_r _ _ j), mod2fin_betweenI.
+ 1,2: rewrite Nat.add_comm. 1,2: split. 1,3: erewrite <- Nat.add_le_mono_l.
+ 1,2: apply Nat.le_0_l. 1,2: rewrite Nat.add_0_r, <- Nat.add_lt_mono_l.
+ 1,2: apply fin_lt. apply H.
+Qed.
+
+Lemma addm_bounded_diffI :
+ ∀ (f : fin u) (j1 j2 : nat), j1 <= j2 -> j2 - j1 < u
+ -> addm f j1 = addm f j2 -> j1 = j2.
+Proof using .
+ intros * Hle Hsu H. rewrite 2 addmE in H.
+ eapply Nat.add_cancel_l, mod2fin_bounded_diffI; try eassumption; lia.
+Qed.
+
+Lemma addm_betweenI : ∀ (p : nat) (f : fin u) (j1 j2 : nat),
+ p <= j1 < p + u -> p <= j2 < p + u -> addm f j1 = addm f j2 -> j1 = j2.
+Proof using .
+ intros p f. eapply (bounded_diff_between _
+ (inj_sym _ _ nat_Setoid (eq_setoid (fin u)) (λ x, addm f x))).
+ intros *. apply addm_bounded_diffI.
+Qed.
+
+Lemma addIf : ∀ f1 : fin u,
+ Preliminary.injective equiv equiv (λ f2, addf f2 f1).
+Proof using . intros f1 f2 f3. rewrite 2 addf_addm. apply addIm. Qed.
+
+Lemma addfI : ∀ f1 : fin u, Preliminary.injective equiv equiv (addf f1).
+Proof using .
+ intros f1 f2 f3 H. eapply addIf. setoid_rewrite addfC. apply H.
+Qed.
+
+Lemma addm0 : ∀ f : fin u, addm f 0 = f.
+Proof using . intros. rewrite addmE, Nat.add_0_r. apply mod2finK. Qed.
+
+Lemma add0m : ∀ j : nat, addm fin0 j = mod2fin j.
+Proof using . intros. rewrite addmE, Nat.add_0_l. reflexivity. Qed.
+
+Lemma add0f : ∀ f : fin u, addf fin0 f = f.
+Proof using . intros. rewrite addf_addm, add0m. apply mod2finK. Qed.
+
+Lemma addf0 : ∀ f : fin u, addf f fin0 = f.
+Proof using . intros. rewrite addf_addm. apply addm0. Qed.
+
+(*
+ *
+ * The successor of a fin u
+ *
+ *)
+
+Definition sucf (f : fin u) : fin u := addf f fin1.
+
+Definition sucf_compat : Proper (equiv ==> equiv) sucf := _.
+
+Lemma sucfE : ∀ f : fin u, sucf f = addf f fin1.
+Proof using . reflexivity. Qed.
+
+Lemma sucfEmod : ∀ f : fin u, sucf f = mod2fin (S f).
+Proof using .
+ intros. destruct (@eq_S_l_lt_dec 0 u _) as [Hd | Hd]. apply all_eq, Hd.
+ unshelve erewrite sucfE, addfE, fin12nat, Nat.add_1_r. apply Hd. reflexivity.
+Qed.
+
+Lemma sucfI : Preliminary.injective equiv equiv sucf.
+Proof using . apply addIf. Qed.
+
+Lemma mod2fin_S_sucf : ∀ j : nat, mod2fin (S j) = sucf (mod2fin j).
+Proof using .
+ intros. rewrite sucfE, addfE, fin1E, addn_mod2fin_idemp_l,
+ addn_mod2fin_idemp_r, Nat.add_1_r. reflexivity.
+Qed.
+
+Lemma sucf_max : sucf fin_max = fin0.
+Proof using . rewrite sucfEmod, fin_max2nat, S_pred_u. apply mod2fin_u. Qed.
+
+Lemma sucf_addf : ∀ f1 f2 : fin u, sucf (addf f1 f2) = addf (sucf f1) f2.
+Proof using . intros. rewrite 2 sucfE. apply addfAC. Qed.
+
+Lemma sucf_addm : ∀ (f : fin u) (j : nat), sucf (addm f j) = addm (sucf f) j.
+Proof using . intros. rewrite 2 addm_addf. apply sucf_addf. Qed.
+
+Lemma addf_sucf : ∀ f1 f2 : fin u, addf (sucf f1) f2 = addf f1 (sucf f2).
+Proof using .
+ intros. rewrite (addfC f1), <-2 sucf_addf, addfC. reflexivity.
+Qed.
+
+Lemma addf_mod2fin_S : ∀ j1 j2 : nat,
+ addf (mod2fin (S j1)) (mod2fin j2) = addf (mod2fin j1) (mod2fin (S j2)).
+Proof using .
+ intros. rewrite mod2fin_S_sucf, addf_sucf, mod2fin_S_sucf. reflexivity.
+Qed.
+
+Lemma S_sucf : ∀ f : fin u, f < fin_max -> S f = sucf f.
+Proof using .
+ intros * H. symmetry. rewrite sucfEmod.
+ apply mod2fin_small, Nat.lt_succ_lt_pred, H.
+Qed.
+
+Lemma lt_sucf : ∀ f : fin u, f < fin_max -> f < sucf f.
+Proof using .
+ intros * H. rewrite <- S_sucf. apply Nat.lt_succ_diag_r. apply H.
+Qed.
+
+Lemma fin1_sucf_fin0 : fin1 = sucf fin0.
+Proof using . rewrite sucfEmod, fin02nat. apply fin1E. Qed.
+
+Lemma lt_sucf_le : ∀ f1 f2 : fin u, f1 < sucf f2 -> f1 <= f2.
+Proof using .
+ intros * H1. apply Nat.lt_succ_r. rewrite S_sucf.
+ apply H1. apply neq_max_lt_max. intros H2. subst.
+ eapply Nat.lt_irrefl, lt_fin0. rewrite <- sucf_max. apply H1.
+Qed.
+
+(*
+ *
+ * The complement to fin_max of either j mod u
+ * (revm whose input is a nat j) or of a fin u (revf)
+ *
+ *)
+
+Lemma revf_subproof : ∀ f : fin u, Nat.pred u - f < u.
+Proof using ltc_l_u.
+ intros. eapply Nat.le_lt_trans. apply Nat.le_sub_l. apply lt_pred_u.
+Qed.
+
+Definition revf (f : fin u) : fin u := Fin (revf_subproof f).
+
+Definition revf_compat : Proper (equiv ==> equiv) revf := _.
+
+Lemma revf2nat : ∀ f : fin u, revf f = Nat.pred u - f :> nat.
+Proof using . reflexivity. Qed.
+
+Lemma revfK : ∀ f : fin u, revf (revf f) = f.
+Proof using .
+intros. apply fin2natI. rewrite 2 revf2nat, sub_sub.
+- hnf. lia.
+- apply fin_le.
+Qed.
+
+Lemma revfI : Preliminary.injective equiv equiv revf.
+Proof using .
+ intros f1 f2 H. setoid_rewrite <- revfK. rewrite H. reflexivity.
+Qed.
+
+Definition revm (j : nat) : fin u := revf (mod2fin j).
+
+Definition revm_compat : Proper (equiv ==> equiv) revm := _.
+
+Lemma revm_revf : ∀ j : nat, revm j = revf (mod2fin j).
+Proof using . reflexivity. Qed.
+
+Lemma revf_revm : ∀ f : fin u, revf f = revm f.
+Proof using . intros. rewrite revm_revf, mod2finK. reflexivity. Qed.
+
+Lemma revm2nat : ∀ j : nat, revm j = Nat.pred u - (j mod u) :> nat.
+Proof using .
+ intros. rewrite revm_revf, revf2nat, mod2fin2nat. reflexivity.
+Qed.
+
+Lemma revm_mod : ∀ j : nat, revm (j mod u) = revm j.
+Proof using . intros. rewrite 2 revm_revf, mod2fin_mod. reflexivity. Qed.
+
+Lemma revm_mod2fin : ∀ j : nat, revm (mod2fin j) = revm j.
+Proof using . intros. rewrite mod2fin2nat. apply revm_mod. Qed.
+
+Lemma revmK : ∀ j : nat, revm (revm j) = mod2fin j.
+Proof using . intros. rewrite 2 revm_revf, mod2finK. apply revfK. Qed.
+
+Lemma revm_bounded_diffI :
+ ∀ j1 j2 : nat, j1 <= j2 -> j2 - j1 < u -> revm j1 = revm j2 -> j1 = j2.
+Proof using .
+ intros. eapply mod_bounded_diffI, sub_cancel_l;
+ try apply mod2fin_lt || apply neq_u_0; trivial; [].
+ rewrite <- (Nat.lt_succ_pred l u) at 1 3.
+ rewrite <- Nat.add_1_r, 2 Nat.add_sub_swap, <-2 revm2nat, H1; trivial;
+ apply Nat.lt_le_pred, mod2fin_lt. apply lt_l_u.
+Qed.
+
+Lemma revm_betweenI : ∀ p j1 j2 : nat,
+ p <= j1 < p + u -> p <= j2 < p + u -> revm j1 = revm j2 -> j1 = j2.
+Proof using .
+ rewrite <- bounded_diff_between. apply revm_bounded_diffI.
+ apply (@inj_sym _ _ (eq_setoid _) (eq_setoid _)).
+Qed.
+
+Lemma revm0 : revm 0 = fin_max.
+Proof using .
+ apply fin2natI. rewrite revm2nat, fin_max2nat, Nat.Div0.mod_0_l.
+ apply Nat.sub_0_r.
+Qed.
+
+Lemma revf0 : revf fin0 = fin_max.
+Proof using . rewrite revf_revm, fin02nat. apply revm0. Qed.
+
+Lemma revf_le_compat : ∀ f1 f2 : fin u, f1 <= f2 -> revf f2 <= revf f1.
+Proof using . intros * H. rewrite 2 revf2nat. apply Nat.sub_le_mono_l, H. Qed.
+
+Lemma revf_lt_compat : ∀ f1 f2 : fin u, f1 < f2 -> revf f2 < revf f1.
+Proof using .
+ intros * H. rewrite 2 revf2nat. apply sub_lt_mono_l. apply fin_le. apply H.
+Qed.
+
+Lemma revm_le_between_compat : ∀ p j1 j2 : nat, u * p <= j1 < u * p + u
+ -> u * p <= j2 < u * p + u -> j1 <= j2 -> revm j2 <= revm j1.
+Proof using .
+ intros * Hb1 Hb2 Hle. rewrite 2 revm2nat. eapply Nat.sub_le_mono_l,
+ mod_le_between_compat. all: eassumption.
+Qed.
+
+Lemma revm_lt_between_compat : ∀ p j1 j2 : nat, u * p <= j1 < u * p + u
+ -> u * p <= j2 < u * p + u -> j1 < j2 -> revm j2 < revm j1.
+Proof using .
+ intros * Hb1 Hb2 Hle. rewrite 2 revm2nat. apply sub_lt_mono_l.
+ apply mod2fin_le. eapply mod_lt_between_compat. all: eassumption.
+Qed.
+
+Lemma revf_fin_max : revf fin_max = fin0.
+Proof using . symmetry. apply revfI. rewrite revfK. apply revf0. Qed.
+
+Lemma revm_fin_max : revm fin_max = fin0.
+Proof using . rewrite <- revf_revm. apply revf_fin_max. Qed.
+
+Lemma addf_revf : ∀ f : fin u, addf (revf f) f = fin_max.
+Proof using .
+ intros. rewrite addfE, revf2nat, Nat.sub_add. apply mod2fin_max. apply fin_le.
+Qed.
+
+(*
+ *
+ * The complement to fin0 of either j mod u
+ * (oppm whose input is a nat j) or of a fin u (oppf)
+ *
+ *)
+
+Definition oppf (f : fin u) : fin u := sucf (revf f).
+
+Definition oppf_compat : Proper (equiv ==> equiv) oppf := _.
+
+Lemma oppfE : ∀ f : fin u, oppf f = sucf (revf f).
+Proof using . reflexivity. Qed.
+
+Lemma oppfEmod : ∀ f : fin u, oppf f = mod2fin (u - f).
+Proof using .
+ intros. rewrite oppfE, sucfEmod, revf2nat, <- Nat.sub_succ_l, S_pred_u;
+ auto using fin_le.
+Qed.
+
+Lemma oppf2nat : ∀ f : fin u, oppf f = (u - f) mod u :> nat.
+Proof using . intros. rewrite oppfEmod. apply mod2fin2nat. Qed.
+
+Definition oppm (j : nat) : fin u := oppf (mod2fin j).
+
+Definition oppm_compat : Proper (equiv ==> equiv) oppm := _.
+
+Lemma oppm_oppf : ∀ j : nat, oppm j = oppf (mod2fin j).
+Proof using . reflexivity. Qed.
+
+Lemma oppf_oppm : ∀ f : fin u, oppf f = oppm f.
+Proof using . intros. rewrite oppm_oppf, mod2finK. reflexivity. Qed.
+
+Lemma oppmE : ∀ j : nat, oppm j = sucf (revm j).
+Proof using . intros. rewrite oppm_oppf, oppfE, revm_revf. reflexivity. Qed.
+
+Lemma oppmEmod : ∀ j : nat, oppm j = mod2fin (u - (j mod u)).
+Proof using .
+ intros. rewrite oppm_oppf, oppfEmod, mod2fin2nat. reflexivity.
+Qed.
+
+Lemma oppm2nat : ∀ j : nat, oppm j = (u - (j mod u)) mod u :> nat.
+Proof using . intros. rewrite oppmEmod. apply mod2fin2nat. Qed.
+
+Lemma oppm_mod : ∀ j : nat, oppm (j mod u) = oppm j.
+Proof using . intros. rewrite 2 oppm_oppf, mod2fin_mod. reflexivity. Qed.
+
+Lemma addfKoppf : ∀ f : fin u, addf (oppf f) f = fin0.
+Proof using .
+ intros. rewrite oppfE, <- sucf_addf, addf_revf. apply sucf_max.
+Qed.
+
+Lemma addmKoppm : ∀ j : nat, addm (oppm j) j = fin0.
+Proof using . intros. rewrite oppm_oppf, addm_addf. apply addfKoppf. Qed.
+
+Lemma oppfKaddf : ∀ f : fin u, addf f (oppf f) = fin0.
+Proof using . intros. rewrite addfC. apply addfKoppf. Qed.
+
+Lemma addfOoppf : ∀ f1 f2 : fin u, addf (oppf f1) (addf f1 f2) = f2.
+Proof using . intros. rewrite addfA, addfKoppf, add0f. reflexivity. Qed.
+
+Lemma oppfOaddf : ∀ f1 f2 : fin u, addf (addf f2 f1) (oppf f1) = f2.
+Proof using . intros. rewrite addfC, (addfC f2 f1). apply addfOoppf. Qed.
+
+Lemma addfOVoppf : ∀ f1 f2 : fin u, addf f1 (addf (oppf f1) f2) = f2.
+Proof using . intros. rewrite (addfC _ f2), addfCA, oppfKaddf. apply addf0. Qed.
+
+Lemma oppfOVaddf : ∀ f1 f2 : fin u, addf (addf f2 (oppf f1)) f1 = f2.
+Proof using . intros. rewrite addfC, (addfC f2 _). apply addfOVoppf. Qed.
+
+Lemma oppmOVaddm : ∀ (f : fin u) (j : nat), addm (addf f (oppm j)) j = f.
+Proof using . intros. rewrite oppm_oppf, addm_addf. apply oppfOVaddf. Qed.
+
+Lemma oppfI : Preliminary.injective equiv equiv oppf.
+Proof using . intros f1 f2 H. eapply revfI, sucfI, H. Qed.
+
+Lemma oppm_bounded_diffI : ∀ j1 j2 : nat, j1 <= j2
+ -> j2 - j1 < u -> oppm j1 = oppm j2 -> j1 = j2.
+Proof using .
+ intros * Hleq Hsub H. rewrite 2 oppmE in H.
+ eapply revm_bounded_diffI, sucfI. all: eassumption.
+Qed.
+
+Lemma oppm_betweenI : ∀ (p : nat) (j1 j2 : nat),
+ p <= j1 < p + u -> p <= j2 < p + u -> oppm j1 = oppm j2 -> j1 = j2.
+Proof using .
+ rewrite <- bounded_diff_between. apply oppm_bounded_diffI.
+ apply (@inj_sym _ _ (eq_setoid _) (eq_setoid _)).
+Qed.
+
+Lemma oppf0 : oppf fin0 = fin0.
+Proof using . rewrite oppfE, revf0. apply sucf_max. Qed.
+
+Lemma oppm0 : oppm 0 = fin0.
+Proof using . rewrite oppm_oppf, mod2fin0. apply oppf0. Qed.
+
+Lemma addn_oppf : ∀ f : fin u, fin0 < f -> f + oppf f = u.
+Proof using .
+intros * H. rewrite oppf2nat, Nat.mod_small, Nat.add_comm, Nat.sub_add.
+- reflexivity.
+- apply Nat.lt_le_incl, fin_lt.
+- apply lt_sub_u, H.
+Qed.
+
+Lemma divide_addn_oppf : ∀ f : fin u, Nat.divide u (f + oppf f).
+Proof using .
+ intros. destruct (eq_fin0_lt_dec f) as [Hd | Hd]. subst. rewrite oppf0,
+ Nat.add_0_r. apply Nat.divide_0_r. rewrite addn_oppf. reflexivity. apply Hd.
+Qed.
+
+Lemma divide_addn_oppm : ∀ j : nat, Nat.divide u (j + oppm j).
+Proof using .
+ intros. rewrite (Nat.div_mod j) at 1. rewrite <- Nat.add_assoc,
+ <- mod2fin2nat, oppm_oppf. apply Nat.divide_add_r. apply Nat.divide_factor_l.
+ apply divide_addn_oppf. apply neq_u_0.
+Qed.
+
+(*
+ *
+ * Substracting either a nat (subm) or
+ * a fin u (subf) to a fin u
+ *
+ *)
+
+Definition subm (f : fin u) (j : nat) : fin u := addm f (oppm j).
+
+Definition subm_compat : Proper (equiv ==> equiv ==> equiv) subm := _.
+
+Definition subf (f1 f2 : fin u) : fin u := addf f1 (oppf f2).
+
+Definition subf_compat : Proper (equiv ==> equiv ==> equiv) subf := _.
+
+Lemma subfE : ∀ f1 f2 : fin u, subf f1 f2 = addf f1 (oppf f2).
+Proof using . reflexivity. Qed.
+
+Lemma submE : ∀ (f : fin u) (j : nat), subm f j = addf f (oppm j).
+Proof using . reflexivity. Qed.
+
+Lemma subf_subm : ∀ f1 f2 : fin u, subf f1 f2 = subm f1 f2.
+Proof using . intros. rewrite submE, subfE, oppf_oppm. reflexivity. Qed.
+
+Lemma subm_subf : ∀ (f : fin u) (j : nat), subm f j = subf f (mod2fin j).
+Proof using . intros. rewrite submE, subfE, oppm_oppf. reflexivity. Qed.
+
+Lemma submEmod : ∀ (f : fin u) (j : nat),
+ subm f j = mod2fin (f + (u - (j mod u))).
+Proof using .
+ intros. rewrite submE, addfE, oppm2nat,
+ <- mod2fin2nat. apply addn_mod2fin_idemp_r.
+Qed.
+
+Lemma subm2nat : ∀ (f : fin u) (j : nat),
+ subm f j = (f + (u - (j mod u))) mod u :> nat.
+Proof using . intros. rewrite submEmod. apply mod2fin2nat. Qed.
+
+Lemma subfEmod : ∀ f1 f2 : fin u, subf f1 f2 = mod2fin (f1 + (u - f2)).
+Proof using .
+ intros. rewrite subf_subm, submEmod, Nat.mod_small. reflexivity. apply fin_lt.
+Qed.
+
+Lemma subf2nat : ∀ f1 f2 : fin u,
+ subf f1 f2 = (f1 + (u - f2)) mod u :> nat.
+Proof using . intros. rewrite subfEmod. apply mod2fin2nat. Qed.
+
+Lemma subm_mod : ∀ (f : fin u) (j : nat), subm f (j mod u) = subm f j.
+Proof using . intros. rewrite 2 subm_subf, mod2fin_mod. reflexivity. Qed.
+
+Lemma subm_mod2fin : ∀ (f : fin u) (j : nat), subm f (mod2fin j) = subm f j.
+Proof using . intros. rewrite mod2fin2nat. apply subm_mod. Qed.
+
+Lemma subIf : ∀ f1 : fin u,
+ Preliminary.injective equiv equiv (λ f2, subf f2 f1).
+Proof using . intros f1 f2 f3 H. eapply addIf, H. Qed.
+
+Lemma subfI : ∀ f1 : fin u,
+ Preliminary.injective equiv equiv (subf f1).
+Proof using . intros f1 f2 f3 H. eapply oppfI, addfI, H. Qed.
+
+Lemma subIm : ∀ j : nat,
+ Preliminary.injective equiv equiv (λ f, subm f j).
+Proof using . intros j f1 f2. rewrite 2 subm_subf. apply subIf. Qed.
+
+Lemma subm_bounded_diffI : ∀ (f : fin u) (j1 j2 : nat),
+ j1 <= j2 -> j2 - j1 < u -> subm f j1 = subm f j2 -> j1 = j2.
+Proof using .
+ intros * Hle Hsu H. rewrite 2 submE in H.
+ eapply oppm_bounded_diffI, addfI. all: eassumption.
+Qed.
+
+Lemma subm_betweenI : ∀ (p : nat) (f : fin u) (j1 j2 : nat),
+ p <= j1 < p + u -> p <= j2 < p + u -> subm f j1 = subm f j2 -> j1 = j2.
+Proof using .
+ intros p f. eapply (bounded_diff_between _
+ (inj_sym _ _ nat_Setoid (eq_setoid (fin u)) (λ x, subm f x))).
+ intros *. apply subm_bounded_diffI.
+Qed.
+
+Lemma sub0f : ∀ f : fin u, subf fin0 f = oppf f.
+Proof using . intros. rewrite subfE. apply add0f. Qed.
+
+Lemma sub0m : ∀ j : nat, subm fin0 j = oppm j.
+Proof using . intros. rewrite submE. apply add0f. Qed.
+
+Lemma subf0 : ∀ f : fin u, subf f fin0 = f.
+Proof using . intros. rewrite subfE, oppf0. apply addf0. Qed.
+
+Lemma subm0 : ∀ f : fin u, subm f 0 = f.
+Proof using . intros. rewrite subm_subf, mod2fin0. apply subf0. Qed.
+
+Lemma subff : ∀ f : fin u, subf f f = fin0.
+Proof using . intros. rewrite subfE. apply oppfKaddf. Qed.
+
+Lemma submm : ∀ j : nat, subm (mod2fin j) (mod2fin j) = fin0.
+Proof using . intros. rewrite subm_subf, mod2finK. apply subff. Qed.
+
+Lemma subfAC : ∀ f1 f2 f3 : fin u,
+ subf (subf f1 f2) f3 = subf (subf f1 f3) f2.
+Proof using . intros. rewrite 4 subfE. apply addfAC. Qed.
+
+Lemma submAC : ∀ (f : fin u) (j1 j2 : nat),
+ subm (subm f j1) j2 = subm (subm f j2) j1.
+Proof using . intros. rewrite 4 submE. apply addmAC. Qed.
+
+Lemma addf_subf : ∀ f1 f2 f3 : fin u,
+ addf (subf f1 f2) f3 = subf (addf f1 f3) f2.
+Proof using . intros. rewrite 2 subfE. apply addfAC. Qed.
+
+Lemma addm_subm : ∀ (f : fin u) (j1 j2 : nat),
+ addm (subm f j2) j1 = subm (addm f j1) j2.
+Proof using . intros. rewrite 2 addm_addf, 2 subm_subf. apply addf_subf. Qed.
+
+Lemma addfKV : ∀ f1 f2 : fin u, subf (addf f1 f2) f1 = f2.
+Proof using . intros. rewrite addfC, subfE. apply oppfOaddf. Qed.
+
+Lemma addfVKV : ∀ f1 f2 : fin u, subf (addf f2 f1) f1 = f2.
+Proof using . intros. rewrite addfC. apply addfKV. Qed.
+
+Lemma addmVKV : ∀ (j : nat) (f : fin u), subm (addm f j) j = f.
+Proof using . intros. rewrite subm_subf, addm_addf. apply addfVKV. Qed.
+
+Lemma subfVK : ∀ f1 f2 : fin u, addf f1 (subf f2 f1) = f2.
+Proof using . intros. eapply subIf. rewrite addfKV. reflexivity. Qed.
+
+Lemma subfVKV : ∀ f1 f2 : fin u, addf (subf f2 f1) f1 = f2.
+Proof using . intros. rewrite addfC. apply subfVK. Qed.
+
+Lemma submVKV : ∀ (j : nat) (f : fin u), addm (subm f j) j = f.
+Proof using . intros. rewrite addm_addf, subm_subf. apply subfVKV. Qed.
+
+(*
+ *
+ * The predecessor of a fin u
+ *
+ *)
+
+Definition pref (f : fin u) : fin u := subf f fin1.
+
+Definition pref_compat : Proper (equiv ==> equiv) pref := _.
+
+Lemma prefE : ∀ f : fin u, pref f = subf f fin1.
+Proof using . reflexivity. Qed.
+
+Lemma prefI : Preliminary.injective equiv equiv pref.
+Proof using . apply subIf. Qed.
+
+Lemma sucfK : ∀ f : fin u, pref (sucf f) = f.
+Proof using . intros. rewrite prefE, sucfE. apply addfVKV. Qed.
+
+Lemma prefK : ∀ f : fin u, sucf (pref f) = f.
+Proof using . intros. rewrite sucfE, prefE. apply subfVKV. Qed.
+
+Lemma prefEmod : ∀ f : fin u, pref f = mod2fin (f + Nat.pred u).
+Proof using .
+ intros. apply sucfI. symmetry. rewrite prefK, <- mod2fin_S_sucf, plus_n_Sm,
+ S_pred_u, <- addn_mod2fin_idemp_r, mod2fin_u, Nat.add_0_r. apply mod2finK.
+Qed.
+
+Lemma revfE : ∀ f : fin u, revf f = pref (oppf f).
+Proof using . intros. rewrite oppfE. symmetry. apply sucfK. Qed.
+
+Lemma pref0 : pref fin0 = fin_max.
+Proof using . rewrite <- sucf_max. apply sucfK. Qed.
+
+Lemma pred_pref : ∀ f : fin u, fin0 < f -> Nat.pred f = pref f.
+Proof using .
+ intros * H. symmetry. apply Nat.succ_inj. erewrite Nat.lt_succ_pred, S_sucf.
+ apply fin2nat_compat, prefK. rewrite <- neq_max_lt_max, <- pref0.
+ eapply not_iff_compat. 2: apply neq_fin0_lt_fin0. 2,3: apply H.
+ split. apply prefI. apply pref_compat.
+Qed.
+
+Lemma pref_subf : ∀ f1 f2 : fin u, pref (subf f1 f2) = subf (pref f1) f2.
+Proof using . intros. rewrite 2 prefE. apply subfAC. Qed.
+
+Lemma pref_subm : ∀ (f : fin u) (j : nat), pref (subm f j) = subm (pref f) j.
+Proof using . intros. rewrite 2 subm_subf. apply pref_subf. Qed.
+
+Lemma sucf_subf : ∀ f1 f2 : fin u, sucf (subf f1 f2) = subf (sucf f1) f2.
+Proof using . intros. rewrite 2 sucfE. apply addf_subf. Qed.
+
+Lemma sucf_subm : ∀ (f : fin u) (j : nat), sucf (subm f j) = subm (sucf f) j.
+Proof using . intros. rewrite 2 subm_subf. apply sucf_subf. Qed.
+
+Lemma pref_addf : ∀ f1 f2 : fin u, pref (addf f1 f2) = addf (pref f1) f2.
+Proof using . intros. rewrite 2 prefE. symmetry. apply addf_subf. Qed.
+
+Lemma pref_addm : ∀ (f : fin u) (j : nat), pref (addm f j) = addm (pref f) j.
+Proof using . intros. rewrite 2 addm_addf. apply pref_addf. Qed.
+
+Lemma addf_pref : ∀ f1 f2 : fin u, addf (pref f1) f2 = addf f1 (pref f2).
+Proof using .
+ intros. rewrite (addfC f1), <- 2 pref_addf, addfC. reflexivity.
+Qed.
+
+Lemma lt_pref : ∀ f : fin u, fin0 < f -> pref f < f.
+Proof using .
+ intros * H. rewrite <- pred_pref. eapply lt_pred. all: apply H.
+Qed.
+
+Lemma fin0_pref_fin1 : fin0 = pref fin1.
+Proof using. symmetry. apply sucfI. rewrite prefK. apply fin1_sucf_fin0. Qed.
+
+Lemma lt_pref_le : ∀ f1 f2 : fin u, pref f1 < f2 -> f1 <= f2.
+Proof using .
+ intros * H1. apply Nat.lt_pred_le. rewrite pred_pref.
+ apply H1. apply neq_fin0_lt_fin0. intros H2. subst.
+ eapply Nat.lt_irrefl, max_lt. rewrite <- pref0. apply H1.
+Qed.
+
+(*
+ *
+ * The complementaries (either to fin_max or fin0)
+ * or the output of several other functions
+ * (then used to prove other lemmas)
+ *
+ *)
+
+Lemma revf_addf : ∀ f1 f2 : fin u, revf (addf f1 f2) = subf (revf f1) f2.
+Proof using .
+ intros. apply fin2natI. erewrite subf2nat, 2 revf2nat, addf2nat,
+ Nat.add_sub_assoc, <- Nat.add_sub_swap, <- (Nat.mod_small (Nat.pred _ - _)),
+ <- Nat.sub_add_distr, <- (Nat.Div0.mod_add (_ - ((_ + _) mod _)) 1), Nat.mul_1_l,
+ <- Nat.add_sub_swap, (Nat.Div0.mod_eq (_ + _)), sub_sub,
+ (Nat.add_sub_swap _ (_ * _)), Nat.mul_comm, Nat.Div0.mod_add. reflexivity.
+ - apply Nat.add_le_mono.
+ + apply Nat.lt_le_pred.
+ apply fin_lt.
+ + apply Nat.lt_le_incl.
+ apply fin_lt.
+ - apply Nat.Div0.mul_div_le.
+ - apply Nat.lt_le_pred.
+ apply mod2fin_lt.
+ - apply lt_sub_lt_add_l.
+ + apply Nat.lt_le_pred.
+ apply mod2fin_lt.
+ + apply Nat.lt_lt_add_l.
+ apply lt_pred_u.
+ - apply Nat.lt_le_pred.
+ apply fin_lt.
+ - apply Nat.lt_le_incl.
+ apply fin_lt.
+Qed.
+
+Lemma revf_addm : ∀ (f : fin u) (j : nat), revf (addm f j) = subm (revf f) j.
+Proof using . intros. rewrite addm_addf. apply revf_addf. Qed.
+
+Lemma revf_sucf : ∀ f : fin u, revf (sucf f) = pref (revf f).
+Proof using . intros. rewrite sucfE, prefE. apply revf_addf. Qed.
+
+Lemma oppf_addf : ∀ f1 f2 : fin u, oppf (addf f1 f2) = subf (oppf f1) f2.
+Proof using . intros. rewrite 2 oppfE, revf_addf. apply sucf_subf. Qed.
+
+Lemma oppf_addm : ∀ (f : fin u) (j : nat), oppf (addm f j) = subm (oppf f) j.
+Proof using . intros. rewrite addm_addf, subm_subf. apply oppf_addf. Qed.
+
+Lemma oppf_sucf : ∀ f : fin u, oppf (sucf f) = pref (oppf f).
+Proof using . intros. rewrite sucfE, prefE. apply oppf_addf. Qed.
+
+Lemma revf_subf : ∀ f1 f2 : fin u, revf (subf f1 f2) = addf (revf f1) f2.
+Proof using .
+ intros. eapply subIf. rewrite <- revf_addf, addfVKV, subfVKV. reflexivity.
+Qed.
+
+Lemma revf_subm : ∀ (f : fin u) (j : nat), revf (subm f j) = addm (revf f) j.
+Proof using . intros. rewrite subm_subf, addm_addf. apply revf_subf. Qed.
+
+Lemma revf_pref : ∀ f : fin u, revf (pref f) = sucf (revf f).
+Proof using . intros. rewrite sucfE, prefE. apply revf_subf. Qed.
+
+Lemma oppf_subf : ∀ f1 f2 : fin u, oppf (subf f2 f1) = subf f1 f2.
+Proof using .
+ intros. rewrite oppfE, revf_subf, sucf_addf,
+ <- oppfE, addfC. symmetry. apply subfE.
+Qed.
+
+Lemma oppf_subm : ∀ (f : fin u) (j : nat),
+ oppf (subm f j) = subf (mod2fin j) f.
+Proof using . intros. rewrite subm_subf. apply oppf_subf. Qed.
+
+Lemma oppf_pref : ∀ f : fin u, oppf (pref f) = sucf (oppf f).
+Proof using . intros. rewrite 2 oppfE, revf_pref. reflexivity. Qed.
+
+Lemma revf_oppf : ∀ f : fin u, revf (oppf f) = pref f.
+Proof using . intros. rewrite oppfE, revf_sucf, revfK. reflexivity. Qed.
+
+Lemma oppfK : ∀ f : fin u, oppf (oppf f) = f.
+Proof using . intros. rewrite oppfE, revf_oppf. apply prefK. Qed.
+
+Lemma oppmK : ∀ j : nat, oppf (oppm j) = mod2fin j.
+Proof using . intros. rewrite oppm_oppf. apply oppfK. Qed.
+
+Lemma oppf_revf : ∀ f : fin u, oppf (revf f) = sucf f.
+Proof using . intros. rewrite oppfE, revfK. reflexivity. Qed.
+
+Lemma addf_subf_oppf : ∀ f1 f2 : fin u, addf f1 f2 = subf f1 (oppf f2).
+Proof using . intros. rewrite subfE, oppfK. reflexivity. Qed.
+
+Lemma addm_subf_oppm : ∀ (f : fin u) (j : nat), addm f j = subf f (oppm j).
+Proof using . intros. rewrite subfE, oppmK. apply addm_addf. Qed.
+
+Lemma subf_subf : ∀ f1 f2 f3 : fin u,
+ subf f1 (subf f2 f3) = subf (addf f1 f3) f2.
+Proof using .
+ intros. rewrite 3subfE, oppf_addf, subfE, oppfK, addfA. apply addfAC.
+Qed.
+
+Lemma subm_subm : ∀ (f1 f2 : fin u) (j : nat),
+ subm f1 (subm f2 j) = subm (addm f1 j) f2.
+Proof using .
+ intros. rewrite <-2 subf_subm, subm_subf, addm_addf. apply subf_subf.
+Qed.
+
+Lemma subf_addf : ∀ f1 f2 f3 : fin u,
+ subf f1 (addf f2 f3) = subf (subf f1 f2) f3.
+Proof using .
+ intros. rewrite 3 subfE, <- addfA, oppf_addf, subfE. reflexivity.
+Qed.
+
+Lemma subf_addf_addf : ∀ f1 f2 f3 : fin u,
+ subf (addf f1 f3) (addf f2 f3) = subf f1 f2.
+Proof using . intros. rewrite <- subf_subf, addfVKV. reflexivity. Qed.
+
+Lemma subf_addm_addm : ∀ (f1 f2 : fin u) (j : nat),
+ subf (addm f1 j) (addm f2 j) = subf f1 f2.
+Proof using . intros. rewrite 2 addm_addf. apply subf_addf_addf. Qed.
+
+Lemma subf_addf_addfC : ∀ f1 f2 f3 : fin u,
+ subf (addf f1 f2) (addf f1 f3) = subf f2 f3.
+Proof using . intros. rewrite 2 (addfC f1). apply subf_addf_addf. Qed.
+
+Lemma subfCAC : ∀ f1 f2 f3 f4 : fin u,
+ subf (subf f1 f2) (subf f3 f4) = subf (subf f1 f3) (subf f2 f4).
+Proof using .
+ intros. rewrite <- subf_addf, addfC, addf_subf, addfC,
+ <- addf_subf, addfC, subf_addf. reflexivity.
+Qed.
+
+Lemma subf_sucf : ∀ f1 f2 : fin u, subf (sucf f1) f2 = subf f1 (pref f2).
+Proof using . intros. rewrite sucfE, prefE. symmetry. apply subf_subf. Qed.
+
+Lemma subf_pref : ∀ f1 f2 : fin u, subf (pref f1) f2 = subf f1 (sucf f2).
+Proof using .
+ intros. rewrite sucfE, prefE, subfAC. symmetry. apply subf_addf.
+Qed.
+
+Lemma oppf1 : oppf fin1 = fin_max.
+Proof using . rewrite fin1_sucf_fin0, oppf_sucf, oppf0. apply pref0. Qed.
+
+Lemma oppm1 : oppm 1 = fin_max.
+Proof using . rewrite oppm_oppf, <- fin1E. apply oppf1. Qed.
+
+Lemma oppf_max : oppf fin_max = fin1.
+Proof using . rewrite <- oppf1. apply oppfK. Qed.
+
+(*
+ *
+ * The symmetric of f by the center c
+ *
+ *)
+
+Definition symf (c f : fin u) : fin u := addf c (subf c f).
+
+Definition symf_compat : Proper (equiv ==> equiv ==> equiv) symf := _.
+
+Lemma symfE : ∀ c f : fin u, symf c f = addf c (subf c f).
+Proof using . reflexivity. Qed.
+
+Lemma symfEmod : ∀ c f : fin u, symf c f = mod2fin (u - f + c + c).
+Proof using .
+ intros. rewrite symfE, addfE, subfEmod, addn_mod2fin_idemp_r, Nat.add_assoc,
+ (Nat.add_comm _ (_ - _)), Nat.add_assoc. reflexivity.
+Qed.
+
+Lemma symf2nat : ∀ c f : fin u, symf c f = (u - f + c + c) mod u :> nat.
+Proof using . intros. rewrite symfEmod. apply mod2fin2nat. Qed.
+
+Lemma symfI : ∀ c : fin u, Preliminary.injective equiv equiv (symf c).
+Proof using . intros c f1 f2 H. eapply subfI, addfI, H. Qed.
+
+Lemma symfK : ∀ c f : fin u, symf c (symf c f) = f.
+Proof using .
+ intros. rewrite 2 symfE, subf_addf, subff, sub0f, oppf_subf. apply subfVK.
+Qed.
+
+Lemma sym0f : ∀ f : fin u, symf fin0 f = oppf f.
+Proof using . intros. rewrite symfE, add0f. apply sub0f. Qed.
+
+Lemma symf0 : ∀ c : fin u, symf c fin0 = addf c c.
+Proof using . intros. rewrite symfE, subf0. reflexivity. Qed.
+
+Lemma symff : ∀ f : fin u, symf f f = f.
+Proof using . intros. rewrite symfE, subff. apply addf0. Qed.
+
+Lemma symf_addf : ∀ c f1 f2 : fin u, symf c (addf f1 f2) = subf (symf c f1) f2.
+Proof using .
+ intros. rewrite 2 symfE, subf_addf, addfC, addf_subf, addfC. reflexivity.
+Qed.
+
+Lemma symf_subf : ∀ c f1 f2 : fin u, symf c (subf f1 f2) = addf (symf c f1) f2.
+Proof using .
+ intros. rewrite 2 symfE, subf_subf, <- addf_subf, addfA. reflexivity.
+Qed.
+
+Lemma symf_sucf : ∀ c f : fin u, symf c (sucf f) = pref (symf c f).
+Proof using . intros. rewrite sucfE, prefE. apply symf_addf. Qed.
+
+Lemma symf_pref : ∀ c f : fin u, symf c (pref f) = sucf (symf c f).
+Proof using . intros. rewrite prefE, sucfE. apply symf_subf. Qed.
+
+(*
+ *
+ * The compatibility between various functions
+ * on fin u and both < and <=
+ *
+ *)
+
+Lemma addm_lt_large : ∀ (f : fin u) (j : nat),
+ fin0 < f -> oppf f <= j mod u -> addm f j < f.
+Proof using .
+ intros * Hlt Hle. erewrite <- (Nat.mod_small f), <- Nat.Div0.mod_add, <- addm_mod,
+ addm2nat, Nat.mul_1_l. eapply mod_lt_between_compat; try rewrite Nat.mul_1_r.
+ - split.
+ + eapply Nat.le_trans.
+ all:swap 1 2.
+ * apply Nat.add_le_mono_l, Hle.
+ * rewrite addn_oppf. reflexivity. apply Hlt.
+ + apply Nat.add_lt_mono;try apply fin_lt.
+ apply mod2fin_lt.
+ - split.
+ + apply Nat.le_add_l.
+ + apply Nat.add_lt_mono_r.
+ apply fin_lt.
+ - apply Nat.add_lt_mono_l.
+ apply mod2fin_lt.
+ - apply fin_lt.
+Qed.
+
+Lemma addm_le_small :
+ ∀ (f : fin u) (j : nat), j mod u < oppf f -> f <= addm f j.
+Proof using .
+ intros * H. destruct (eq_fin0_lt_dec f) as [| Hd]. subst. apply fin0_le.
+ erewrite <- (Nat.mod_small f), <- addm_mod, addm2nat.
+ eapply mod_le_between_compat. 1,2: rewrite Nat.mul_0_r. apply fin_between.
+ 2: apply Nat.le_add_r. 2: apply fin_lt. split. apply Nat.le_0_l.
+ eapply Nat.lt_le_trans. apply Nat.add_lt_mono_l, H.
+ rewrite addn_oppf. reflexivity. apply Hd.
+Qed.
+
+Lemma addm_lt_small :
+ ∀ (f : fin u) (j : nat), fin0 < j mod u < oppf f -> f < addm f j.
+Proof using .
+ intros * [H1 H2]. apply Nat.le_neq. split. apply addm_le_small, H2.
+ intros Habs. apply <- Nat.neq_0_lt_0. apply H1. eapply addm_betweenI.
+ 1,2: rewrite Nat.add_0_l. 1,2: split. 1,3: apply Nat.le_0_l. apply mod2fin_lt.
+ apply lt_0_u. symmetry. rewrite addm0, addm_mod. apply fin2natI, Habs.
+Qed.
+
+Lemma addf_lt_large :
+ ∀ f1 f2 : fin u, fin0 < f1 -> oppf f1 <= f2 -> addf f1 f2 < f1.
+Proof using .
+ intros * Hlt Hle. rewrite addf_addm. apply addm_lt_large. apply Hlt.
+ rewrite Nat.mod_small by apply fin_lt. apply Hle.
+Qed.
+
+Lemma addf_le_small :
+ ∀ f1 f2 : fin u, f2 < oppf f1 -> f1 <= addf f1 f2.
+Proof using .
+ intros * H. rewrite addf_addm. apply addm_le_small.
+ rewrite Nat.mod_small by apply fin_lt. apply H.
+Qed.
+
+Lemma addf_lt_small : ∀ f1 f2 : fin u, fin0 < f2 < oppf f1 -> f1 < addf f1 f2.
+Proof using .
+ intros * H. rewrite addf_addm. apply addm_lt_small.
+ rewrite Nat.mod_small. apply H. apply fin_lt.
+Qed.
+
+Lemma addm_le_compat_large : ∀ (f : fin u) (j1 j2 : nat),
+ oppf f <= j1 mod u <= j2 mod u -> addm f j1 <= addm f j2.
+Proof using .
+ intros * [H1 H2]. destruct (eq_fin0_lt_dec f) as [| Hd].
+ - subst. rewrite (add0m j1), (add0m j2), 2 mod2fin2nat. apply H2.
+ - rewrite <- (addm_mod f j1), <- (addm_mod f j2), 2 addmE.
+ eapply mod2fin_le_between_compat. 3: apply Nat.add_le_mono_l, H2.
+ all: rewrite Nat.mul_1_r. all: split. 2,4: apply Nat.add_lt_mono, mod2fin_lt.
+ 2,3: apply fin_lt. all: eapply Nat.le_trans. 2,4: apply Nat.add_le_mono_l.
+ 3: eapply Nat.le_trans. 2,3: apply H1. 2: apply H2. all: rewrite addn_oppf.
+ 1,3: reflexivity. all: apply Hd.
+Qed.
+
+Lemma addm_le_compat_small : ∀ (f : fin u) (j1 j2 : nat),
+ j1 mod u <= j2 mod u < oppf f -> addm f j1 <= addm f j2.
+Proof using .
+ intros * [H1 H2]. destruct (eq_fin0_lt_dec f) as [| Hd].
+ - subst. rewrite (add0m j1), (add0m j2), 2 mod2fin2nat. apply H1.
+ - rewrite <- (addm_mod f j1), <- (addm_mod f j2), 2 addmE.
+ eapply mod2fin_le_between_compat. 3: apply Nat.add_le_mono_l, H1.
+ all: rewrite Nat.mul_0_r, Nat.add_0_l. all: split. 1,3: apply Nat.le_0_l.
+ eapply Nat.le_lt_trans. apply Nat.add_le_mono_l, H1. all: eapply Nat.lt_le_trans.
+ 1,3: apply Nat.add_lt_mono_l, H2. all: rewrite addn_oppf.
+ 1,3: reflexivity. all: apply Hd.
+Qed.
+
+Lemma addf_le_compat_large : ∀ f1 f2 f3 : fin u,
+ oppf f1 <= f2 <= f3 -> addf f1 f2 <= addf f1 f3.
+Proof using .
+ intros * H. rewrite 2 addf_addm. apply addm_le_compat_large.
+ rewrite 2 Nat.mod_small by apply fin_lt. apply H.
+Qed.
+
+Lemma addf_le_compat_small : ∀ f1 f2 f3 : fin u,
+ f2 <= f3 < oppf f1 -> addf f1 f2 <= addf f1 f3.
+Proof using .
+ intros * H. rewrite 2 addf_addm. apply addm_le_compat_small.
+ rewrite 2 Nat.mod_small by apply fin_lt. apply H.
+Qed.
+
+Lemma addm_lt_compat_large : ∀ (f : fin u) (j1 j2 : nat),
+ oppf f <= j1 mod u < j2 mod u -> addm f j1 < addm f j2.
+Proof using .
+ intros * [H1 H2]. apply Nat.le_neq. split. apply addm_le_compat_large.
+ split. apply H1. apply Nat.lt_le_incl, H2. rewrite <- (addm_mod _ j1),
+ <- (addm_mod _ j2). intros Habs. eapply Nat.lt_irrefl.
+ erewrite addm_betweenI. apply H2. 3: apply fin2natI, Habs.
+ all: split. 1,3: apply Nat.le_0_l. all: apply mod2fin_lt.
+Qed.
+
+Lemma addm_lt_compat_small : ∀ (f : fin u) (j1 j2 : nat),
+ j1 mod u < j2 mod u < oppf f -> addm f j1 < addm f j2.
+Proof using .
+ intros * [H1 H2]. apply Nat.le_neq. split. apply addm_le_compat_small.
+ split. apply Nat.lt_le_incl, H1. apply H2. rewrite <- (addm_mod _ j1),
+ <- (addm_mod _ j2). intros Habs. eapply Nat.lt_irrefl.
+ erewrite addm_betweenI. apply H1. 3: apply fin2natI, Habs.
+ all: split. 1,3: apply Nat.le_0_l. all: apply mod2fin_lt.
+Qed.
+
+Lemma addf_lt_compat_large :
+ ∀ f1 f2 f3 : fin u, oppf f1 <= f2 < f3 -> addf f1 f2 < addf f1 f3.
+Proof using .
+ intros * H. rewrite 2 addf_addm. apply addm_lt_compat_large.
+ rewrite 2 Nat.mod_small. apply H. all: apply fin_lt.
+Qed.
+
+Lemma addf_lt_compat_small :
+ ∀ f1 f2 f3 : fin u, f2 < f3 < oppf f1 -> addf f1 f2 < addf f1 f3.
+Proof using .
+ intros * H. rewrite 2 addf_addm. apply addm_lt_compat_small.
+ rewrite 2 Nat.mod_small. apply H. all: apply fin_lt.
+Qed.
+
+Lemma lt_fin0_oppf : ∀ f : fin u, fin0 < f -> fin0 < oppf f.
+Proof using .
+ intros * H1. apply neq_fin0_lt_fin0 in H1. apply neq_fin0_lt_fin0. intros H2.
+ apply H1. apply oppfI. rewrite oppf0. apply H2.
+Qed.
+
+Lemma oppf_le_compat : ∀ f1 f2 : fin u, fin0 < f1 <= f2 -> oppf f2 <= oppf f1.
+Proof using .
+ intros * [H1 H2]. rewrite 2 oppfEmod. eapply mod2fin_le_between_compat.
+ 1,2: rewrite Nat.mul_0_r, Nat.add_0_l. 1,2: split. 1,3: apply Nat.le_0_l.
+ 3: apply Nat.sub_le_mono_l, H2. all: apply lt_sub_u.
+ eapply Nat.lt_le_trans. 1,3: apply H1. apply H2.
+Qed.
+
+Lemma oppf_lt_compat : ∀ f1 f2 : fin u, fin0 < f1 < f2 -> oppf f2 < oppf f1.
+Proof using .
+ intros * [H1 H2]. rewrite <- (Nat.lt_succ_pred 0 (oppf f1)). apply Nat.lt_succ_r.
+ rewrite pred_pref, <- oppf_sucf. apply oppf_le_compat. rewrite <- S_sucf.
+ split. apply Nat.lt_0_succ. 2: eapply Nat.lt_le_trans. 1,2: apply H2.
+ apply le_max. all: apply lt_fin0_oppf, H1.
+Qed.
+
+Lemma oppf_le_inj : ∀ f1 f2 : fin u, fin0 < oppf f2 <= oppf f1 -> f1 <= f2.
+Proof using .
+ intros * H. rewrite <- (oppfK f1), <- (oppfK f2). apply oppf_le_compat, H.
+Qed.
+
+Lemma oppf_lt_inj : ∀ f1 f2 : fin u, fin0 < oppf f2 < oppf f1 -> f1 < f2.
+Proof using .
+ intros * H. rewrite <- (oppfK f1), <- (oppfK f2). apply oppf_lt_compat, H.
+Qed.
+
+Lemma opmm_le_compat :
+ ∀ j1 j2 : nat, fin0 < j1 mod u <= j2 mod u -> oppm j2 <= oppm j1.
+Proof using .
+ intros * H. rewrite 2 oppm_oppf. apply oppf_le_compat.
+ rewrite 2 mod2fin2nat. apply H.
+Qed.
+
+Lemma oppm_lt_compat :
+ ∀ j1 j2 : nat, fin0 < j1 mod u < j2 mod u -> oppm j2 < oppm j1.
+Proof using .
+ intros * H. rewrite 2 oppm_oppf. apply oppf_lt_compat.
+ rewrite 2 mod2fin2nat. apply H.
+Qed.
+
+Lemma oppm_le_inj :
+ ∀ j1 j2 : nat, fin0 < oppm j2 <= oppm j1 -> j1 mod u <= j2 mod u.
+Proof using .
+ intros * H. rewrite <-2 mod2fin2nat. apply oppf_le_inj.
+ rewrite <-2 oppm_oppf. apply H.
+Qed.
+
+Lemma oppm_lt_inj :
+ ∀ j1 j2 : nat, fin0 < oppm j2 < oppm j1 -> j1 mod u < j2 mod u.
+Proof using .
+ intros * H. rewrite <-2 mod2fin2nat. apply oppf_lt_inj.
+ rewrite <-2 oppm_oppf. apply H.
+Qed.
+
+Lemma lt_fin0_subf : ∀ f1 f2 : fin u, f1 ≠f2 -> fin0 < subf f1 f2.
+Proof using .
+ intros * H1. apply neq_fin0_lt_fin0. intros H2. apply H1.
+ eapply subIf. rewrite (subff f2). apply H2.
+Qed.
+
+Lemma subf_lt_small : ∀ f1 f2 : fin u, fin0 < f2 <= f1 -> subf f1 f2 < f1.
+Proof using .
+ intros * H. rewrite subfE. apply addf_lt_large.
+ 2: apply oppf_le_compat, H. eapply Nat.lt_le_trans. all: apply H.
+Qed.
+
+Lemma subf_le_small :
+ ∀ f1 f2 : fin u, f2 <= f1 -> subf f1 f2 <= f1.
+Proof using .
+ intros * H. destruct (eq_fin0_lt_dec f1) as [| H1]. subst.
+ rewrite sub0f, le_fin0, <- oppf0. f_equal. apply le_fin0, H.
+ destruct (eq_fin0_lt_dec f2) as [| H2]. subst. rewrite subf0.
+ reflexivity. rewrite subfE. apply Nat.lt_le_incl, addf_lt_large.
+ apply H1. apply oppf_le_compat. split. apply H2. apply H.
+Qed.
+
+Lemma subf_lt_large : ∀ f1 f2 : fin u, fin0 < f1 < f2 -> f1 < subf f1 f2.
+Proof using .
+ intros * H. rewrite subfE. apply addf_lt_small. split.
+ 2: apply oppf_lt_compat, H. eapply lt_fin0_oppf, Nat.lt_trans. all: apply H.
+Qed.
+
+Lemma subf_le_large : ∀ f1 f2 : fin u, f1 < f2 -> f1 <= subf f1 f2.
+Proof using .
+ intros * H. destruct (eq_fin0_lt_dec f1) as [| Hd]. subst. apply fin0_le.
+ rewrite subfE. apply addf_le_small, oppf_lt_compat. split. apply Hd. apply H.
+Qed.
+
+Lemma subm_lt_small :
+ ∀ (f : fin u) (j : nat), fin0 < j mod u <= f -> subm f j < f.
+Proof using .
+ intros * H. rewrite subm_subf. apply subf_lt_small.
+ rewrite mod2fin2nat. apply H.
+Qed.
+
+Lemma subm_le_small :
+ ∀ (f : fin u) (j : nat), j mod u <= f -> subm f j <= f.
+Proof using .
+ intros * H. rewrite subm_subf. apply subf_le_small.
+ rewrite mod2fin2nat. apply H.
+Qed.
+
+Lemma subm_lt_large :
+ ∀ (f : fin u) (j : nat), fin0 < f < j mod u -> f < subm f j.
+Proof using .
+ intros * H. rewrite subm_subf. apply subf_lt_large.
+ rewrite mod2fin2nat. apply H.
+Qed.
+
+Lemma subm_le_large : ∀ (f : fin u) (j : nat), f < j mod u -> f <= subm f j.
+Proof using .
+ intros * H. rewrite subm_subf. apply subf_le_large.
+ rewrite mod2fin2nat. apply H.
+Qed.
+
+Lemma subf_le_compat_small :
+ ∀ f1 f2 f3 : fin u, f3 <= f2 <= f1 -> subf f1 f2 <= subf f1 f3.
+Proof using .
+ intros * H. destruct (eq_fin0_lt_dec f3) as [| Hd]. subst.
+ rewrite subf0. apply subf_le_small, H. rewrite 2 subfE.
+ apply addf_le_compat_large. split. all: apply oppf_le_compat.
+ all: split. eapply Nat.lt_le_trans. 1,4: apply Hd. all: apply H.
+Qed.
+
+Lemma subf_le_compat_large :
+ ∀ f1 f2 f3 : fin u, f1 < f3 <= f2 -> subf f1 f2 <= subf f1 f3.
+Proof using .
+ intros * H. destruct (eq_fin0_lt_dec f1) as [| Hd]. subst.
+ rewrite 2 sub0f. apply oppf_le_compat, H. rewrite 2 subfE.
+ apply addf_le_compat_small. split. apply oppf_le_compat. split.
+ eapply lt_fin0. 1,2: apply H. apply oppf_lt_compat. split. apply Hd. apply H.
+Qed.
+
+Lemma subf_lt_compat_small :
+ ∀ f1 f2 f3 : fin u, f3 < f2 <= f1 -> subf f1 f2 < subf f1 f3.
+Proof using .
+ intros * H. destruct (eq_fin0_lt_dec f3) as [| Hd]. subst.
+ rewrite subf0. apply subf_lt_small, H. rewrite 2 subfE.
+ apply addf_lt_compat_large. split. apply oppf_le_compat. split.
+ eapply lt_fin0. 1,2: apply H. apply oppf_lt_compat. split. apply Hd. apply H.
+Qed.
+
+Lemma subf_lt_compat_large :
+ ∀ f1 f2 f3 : fin u, f1 < f3 < f2 -> subf f1 f2 < subf f1 f3.
+Proof using .
+ intros * H. destruct (eq_fin0_lt_dec f1) as [| Hd]. subst.
+ rewrite 2 sub0f. apply oppf_lt_compat, H. rewrite 2 subfE.
+ apply addf_lt_compat_small. split. all: apply oppf_lt_compat.
+ all: split. eapply lt_fin0. 1,2,4: apply H. apply Hd.
+Qed.
+
+Lemma subm_le_compat_small : ∀ (f : fin u) (j1 j2 : nat),
+ j2 mod u <= j1 mod u <= f -> subm f j1 <= subm f j2.
+Proof using .
+ intros * H. rewrite 2 subm_subf. apply subf_le_compat_small.
+ rewrite 2 mod2fin2nat. apply H.
+Qed.
+
+Lemma subm_le_compat_large : ∀ (f : fin u) (j1 j2 : nat),
+ f < j2 mod u <= j1 mod u -> subm f j1 <= subm f j2.
+Proof using .
+ intros * H. rewrite 2 subm_subf. apply subf_le_compat_large.
+ rewrite 2 mod2fin2nat. apply H.
+Qed.
+
+Lemma subm_lt_compat_small : ∀ (f : fin u) (j1 j2 : nat),
+ j2 mod u < j1 mod u <= f -> subm f j1 < subm f j2.
+Proof using .
+ intros * H. rewrite 2 subm_subf. apply subf_lt_compat_small.
+ rewrite 2 mod2fin2nat. apply H.
+Qed.
+
+Lemma subm_lt_compat_large : ∀ (f : fin u) (j1 j2 : nat),
+ f < j2 mod u < j1 mod u -> subm f j1 < subm f j2.
+Proof using .
+ intros * H. rewrite 2 subm_subf. apply subf_lt_compat_large.
+ rewrite 2 mod2fin2nat. apply H.
+Qed.
+
+Lemma subf_lt_smallV : ∀ f1 f2 : fin u, fin0 < f2 < f1 -> subf f1 f2 < oppf f2.
+Proof using .
+ intros * H. apply oppf_lt_inj. rewrite oppfK, oppf_subf.
+ split. apply H. apply subf_lt_large, H.
+Qed.
+
+Lemma subf_le_smallV :
+ ∀ f1 f2 : fin u, fin0 < f2 < f1 -> subf f1 f2 <= oppf f2.
+Proof using .
+ intros * H. apply oppf_le_inj. rewrite oppfK, oppf_subf.
+ split. apply H. apply subf_le_large, H.
+Qed.
+
+Lemma subf_lt_largeV : ∀ f1 f2 : fin u, fin0 < f1 < f2 -> oppf f2 < subf f1 f2.
+Proof using .
+ intros * H. apply oppf_lt_inj. rewrite oppfK, oppf_subf. split.
+ apply lt_fin0_subf, lt_gt_cases. right. 2: apply subf_lt_small.
+ 2: split. 3: apply Nat.lt_le_incl. all: apply H.
+Qed.
+
+Lemma subf_le_largeV : ∀ f1 f2 : fin u, f1 < f2 -> oppf f2 <= subf f1 f2.
+Proof using .
+ intros * H. apply oppf_le_inj. rewrite oppfK, oppf_subf. split.
+ apply lt_fin0_subf, lt_gt_cases. right. 2: apply subf_le_small.
+ 2: apply Nat.lt_le_incl. all: apply H.
+Qed.
+
+Lemma subf_le_compat_largeV :
+ ∀ f1 f2 f3 : fin u, f1 <= f3 <= f2 -> subf f3 f1 <= subf f2 f1.
+Proof using .
+ intros * [H1 H2]. destruct (le_lt_eq_dec H1) as [Hd |]. 2:{ subst.
+ rewrite subff. apply fin0_le. } apply oppf_le_inj. rewrite 2 oppf_subf.
+ split. apply lt_fin0_subf, lt_gt_cases. left. eapply Nat.lt_le_trans.
+ 3: apply subf_le_compat_large. 3: split. 1,3: apply Hd. all: apply H2.
+Qed.
+
+Lemma subf_le_compat_smallV :
+ ∀ f1 f2 f3 : fin u, f3 <= f2 < f1 -> subf f3 f1 <= subf f2 f1.
+Proof using .
+ intros * H. apply oppf_le_inj. rewrite 2 oppf_subf. split.
+ apply lt_fin0_subf, lt_gt_cases. right. 2: apply subf_le_compat_small.
+ 2: split. 3: apply Nat.lt_le_incl. all: apply H.
+Qed.
+
+Lemma subf_lt_compat_largeV :
+ ∀ f1 f2 f3 : fin u, f1 <= f3 < f2 -> subf f3 f1 < subf f2 f1.
+Proof using .
+ intros * [H1 H2]. destruct (le_lt_eq_dec H1) as [Hd |]. 2: subst.
+ 2: rewrite subff. apply oppf_lt_inj. rewrite 2 oppf_subf. split.
+ 1,3: apply lt_fin0_subf, lt_gt_cases. 3: apply subf_lt_compat_large.
+ left. 2: right. 3: split. eapply Nat.lt_trans. 1,4: apply Hd. all: apply H2.
+Qed.
+
+Lemma subf_lt_compat_smallV :
+ ∀ f1 f2 f3 : fin u, f3 < f2 < f1 -> subf f3 f1 < subf f2 f1.
+Proof using .
+ intros * H. apply oppf_lt_inj. rewrite 2 oppf_subf. split.
+ apply lt_fin0_subf, lt_gt_cases. right. 2: apply subf_lt_compat_small.
+ 2: split. 3: apply Nat.lt_le_incl. all: apply H.
+Qed.
+
+Lemma sucf_le_compat :
+ ∀ f1 f2 : fin u, f1 <= f2 < fin_max -> sucf f1 <= sucf f2.
+Proof using .
+ intros * H. rewrite 2 sucfE, (addfC f1), (addfC f2).
+ apply addf_le_compat_small. rewrite oppf1. apply H.
+Qed.
+
+Lemma sucf_lt_compat :
+ ∀ f1 f2 : fin u, f1 < f2 < fin_max -> sucf f1 < sucf f2.
+Proof using .
+ intros * H. rewrite 2 sucfE, (addfC f1), (addfC f2).
+ apply addf_lt_compat_small. rewrite oppf1. apply H.
+Qed.
+
+Lemma pref_le_compat :
+ ∀ f1 f2 : fin u, fin0 < f1 <= f2 -> pref f1 <= pref f2.
+Proof using .
+ intros * H. rewrite 2 prefE. apply subf_le_compat_largeV. split.
+ 2: apply H. apply lt_pref_le. rewrite <- fin0_pref_fin1. apply H.
+Qed.
+
+Lemma pref_lt_compat : ∀ f1 f2 : fin u, fin0 < f1 < f2 -> pref f1 < pref f2.
+Proof using .
+ intros * H. rewrite 2 prefE. apply subf_lt_compat_largeV. split.
+ 2: apply H. apply lt_pref_le. rewrite <- fin0_pref_fin1. apply H.
+Qed.
+
+(*
+ *
+ * The bijections on fin u whose section adds
+ * and whose retraction substracts
+ *
+ *)
+
+Definition asbf (f : fin u) : bijection (fin u) :=
+ cancel_bijection (λ f2 : fin u, subf f2 f) _ (@addIf f)
+ (addfVKV f) (subfVKV f).
+Global Opaque asbf.
+
+Definition asbm (j : nat) : bijection (fin u) :=
+ cancel_bijection (λ f : fin u, subm f j) _ (@addIm j)
+ (addmVKV j) (submVKV j).
+Global Opaque asbm.
+
+Lemma asbfE : ∀ f1 : fin u, asbf f1 = (λ f2, addf f2 f1) :> (fin u -> fin u).
+Proof using . reflexivity. Qed.
+
+Lemma asbfVE :
+ ∀ f1 : fin u, (asbf f1)â»Â¹ = (λ f2, subf f2 f1) :> (fin u -> fin u).
+Proof using . reflexivity. Qed.
+
+Lemma asbmE : ∀ j : nat, asbm j = (λ f, addm f j) :> (fin u -> fin u).
+Proof using . reflexivity. Qed.
+
+Lemma asbmVE : ∀ j : nat, (asbm j)â»Â¹ = (λ f, subm f j) :> (fin u -> fin u).
+Proof using . reflexivity. Qed.
+
+Lemma asbm_asbf : ∀ j : nat, asbm j == asbf (mod2fin j).
+Proof using . intros j f. rewrite asbmE, asbfE. apply addm_addf. Qed.
+
+Lemma asbf_asbm : ∀ f1 : fin u, asbf f1 == asbm f1.
+Proof using . intros f1 f2. rewrite asbmE, asbfE. apply addf_addm. Qed.
+
+Lemma asbmV_asbfV : ∀ j : nat, (asbm j)â»Â¹ == (asbf (mod2fin j))â»Â¹.
+Proof using . intros j f. rewrite asbmVE, asbfVE. apply subm_subf. Qed.
+
+Lemma asbfV_asbmV : ∀ f1 : fin u, (asbf f1)â»Â¹ == (asbm f1)â»Â¹.
+Proof using . intros f1 f2. rewrite asbmVE, asbfVE. apply subf_subm. Qed.
+
+Lemma asbm_mod : ∀ j : nat, asbm (j mod u) == asbm j.
+Proof using . intros j f. rewrite 2 asbmE. apply addm_mod. Qed.
+
+Lemma asbmV_mod : ∀ j : nat, (asbm (j mod u))â»Â¹ == (asbm j)â»Â¹.
+Proof using . intros j f. rewrite 2 asbmVE. apply subm_mod. Qed.
+
+Lemma asbm0 : asbm 0 == id.
+Proof using . intros f. rewrite asbmE. apply addm0. Qed.
+
+Lemma asbf0 : asbf fin0 == id.
+Proof using . intros f. rewrite asbfE. apply addf0. Qed.
+
+Lemma asbfAC : ∀ f1 f2 : fin u, asbf f2 ∘ (asbf f1) == asbf f1 ∘ (asbf f2).
+Proof using . intros * f3. rewrite 2 compE, 2 asbfE. apply addfAC. Qed.
+
+Lemma asbmAC : ∀ j1 j2 : nat, asbm j2 ∘ (asbm j1) == asbm j1 ∘ (asbm j2).
+Proof using . intros * f. rewrite 2 compE, 2 asbmE. apply addmAC. Qed.
+
+Lemma asbmVAC :
+ ∀ j1 j2 : nat, (asbm j2)â»Â¹ ∘ (asbm j1)â»Â¹ == (asbm j1)â»Â¹ ∘ (asbm j2)â»Â¹.
+Proof using . intros * f. rewrite 2 compE, 2 asbmVE. apply submAC. Qed.
+
+Lemma asbfVAC :
+ ∀ f1 f2 : fin u, (asbf f2)â»Â¹ ∘ (asbf f1)â»Â¹ == (asbf f1)â»Â¹ ∘ (asbf f2)â»Â¹.
+Proof using . intros * f3. rewrite 2 compE, 2 asbfVE. apply subfAC. Qed.
+
+Lemma asbmCV : ∀ j1 j2 : nat, asbm j1 ∘ (asbm j2)â»Â¹ == (asbm j2)â»Â¹ ∘ (asbm j1).
+Proof using . intros * f. rewrite 2 compE, asbmVE, asbmE. apply addm_subm. Qed.
+
+Lemma asbfCV :
+ ∀ f1 f2 : fin u, asbf f1 ∘ (asbf f2)â»Â¹ == (asbf f2)â»Â¹ ∘ (asbf f1).
+Proof using . intros * f3. rewrite 2 compE, asbfVE, asbfE. apply addf_subf. Qed.
+
+Lemma asbfA : ∀ f1 f2 : fin u, asbf (asbf f1 f2) == asbf f1 ∘ (asbf f2).
+Proof using . intros * f3. rewrite compE, 3 asbfE. apply addfA. Qed.
+
+Lemma asbfAV :
+ ∀ f1 f2 : fin u, asbf ((asbf f1)â»Â¹ f2) == (asbf f1)â»Â¹ ∘ (asbf f2).
+Proof using .
+ intros * f3. rewrite compE, 2 asbfE,
+ asbfVE, addfC, (addfC f3). apply addf_subf.
+Qed.
+
+Lemma asbfVA :
+ ∀ f1 f2 : fin u, (asbf (asbf f1 f2))â»Â¹ == (asbf f1)â»Â¹ ∘ (asbf f2)â»Â¹.
+Proof using .
+ intros * f3. rewrite compE, 3 asbfVE, asbfE. apply subf_addf.
+Qed.
+
+Lemma asbfVAV :
+ ∀ f1 f2 : fin u, (asbf ((asbf f1)â»Â¹ f2))â»Â¹ == asbf f1 ∘ (asbf f2)â»Â¹.
+Proof using .
+ intros * f3. rewrite compE, 3 asbfVE, asbfE, addf_subf. apply subf_subf.
+Qed.
+
+Lemma asbfVf : ∀ f : fin u, (asbf f)â»Â¹ f = fin0.
+Proof using . intros. rewrite asbfVE. apply subff. Qed.
+
+(*
+ *
+ * The bijection on fin u whose section is sucf
+ * and whose retraction is pref
+ *
+ *)
+
+Definition spbf : bijection (fin u)
+ := cancel_bijection pref _ sucfI sucfK prefK.
+Global Opaque spbf.
+
+Lemma spbfE : spbf = sucf :> (fin u -> fin u).
+Proof using . reflexivity. Qed.
+
+Lemma spbfVE : spbfâ»Â¹ = pref :> (fin u -> fin u).
+Proof using . reflexivity. Qed.
+
+Lemma asbf1 : asbf fin1 == spbf.
+Proof using . intros f. rewrite asbfE, spbfE. symmetry. apply sucfE. Qed.
+
+Lemma asbm1 : asbm 1 == spbf.
+Proof using . rewrite asbm_asbf, <- fin1E. apply asbf1. Qed.
+
+(*
+ *
+ * The bijection on fin u whose section and retraction are revf
+ *
+ *)
+
+Definition rebf : bijection (fin u)
+ := cancel_bijection revf _ revfI revfK revfK.
+Global Opaque rebf.
+
+Lemma rebfE : rebf = revf :> (fin u -> fin u).
+Proof using . reflexivity. Qed.
+
+Lemma rebfVE : rebfâ»Â¹ = revf :> (fin u -> fin u).
+Proof using . reflexivity. Qed.
+
+Lemma rebfV : rebfâ»Â¹ == rebf.
+Proof using . intros f. rewrite rebfE, rebfVE. reflexivity. Qed.
+
+(*
+ *
+ * The bijection on fin u whose section and retraction are oppf
+ *
+ *)
+
+Definition opbf : bijection (fin u)
+ := cancel_bijection oppf _ oppfI oppfK oppfK.
+Global Opaque opbf.
+
+Lemma opbfE : opbf = oppf :> (fin u -> fin u).
+Proof using . reflexivity. Qed.
+
+Lemma opbfVE : opbfâ»Â¹ = oppf :> (fin u -> fin u).
+Proof using . reflexivity. Qed.
+
+Lemma opbfV : opbfâ»Â¹ == opbf.
+Proof using . intros f. rewrite opbfE, opbfVE. reflexivity. Qed.
+
+Lemma spbf_rebf : spbf ∘ rebf == opbf.
+Proof using .
+ intros f. rewrite compE, spbfE, rebfE, opbfE. symmetry. apply oppfE.
+Qed.
+
+Lemma spbfV_opbf : spbfâ»Â¹ ∘ opbf == rebf.
+Proof using.
+ rewrite <- spbf_rebf, compose_assoc, compose_inverse_l. apply id_comp_l.
+Qed.
+
+(*
+ *
+ * The bijection on fin u whose section and retraction are symf
+ *
+ *)
+
+Definition sybf (c : fin u) : bijection (fin u) :=
+ cancel_bijection (symf c) _ (@symfI c) (symfK c) (symfK c).
+Global Opaque sybf.
+
+Lemma sybfE : ∀ c : fin u, sybf c = symf c :> (fin u -> fin u).
+Proof using . reflexivity. Qed.
+
+Lemma sybfVE : ∀ c : fin u, sybf câ»Â¹ = symf c :> (fin u -> fin u).
+Proof using . reflexivity. Qed.
+
+Lemma sybfV : ∀ c : fin u, sybf câ»Â¹ == sybf c.
+Proof using . intros c f. rewrite sybfE, sybfVE. reflexivity. Qed.
+
+Lemma sybfK : ∀ c : fin u, sybf c ∘ sybf c == id.
+Proof using . intros c f. rewrite compE, sybfE. apply symfK. Qed.
+
+Lemma sybff : ∀ c : fin u, sybf c c = c.
+Proof using . intros. rewrite sybfE. apply symff. Qed.
+
+End mod2fin.
diff --git a/Util/Lexprod.v b/Util/Lexprod.v
index 1bd89797fb3be6e10eb952ab524614e918c88029..c468d2287fa46b8dca1f1dac7de35b211045c5f9 100644
--- a/Util/Lexprod.v
+++ b/Util/Lexprod.v
@@ -79,7 +79,7 @@ End WfLexicographic_Product.
Global Arguments lexprod [A] [B] leA leB _ _.
-Instance lexprod_compat: Proper (eq * eq ==> eq * eq ==> iff) (lexprod lt lt).
+Global Instance lexprod_compat: Proper (eq * eq ==> eq * eq ==> iff) (lexprod lt lt).
Proof using .
intros (a, b) (a', b') (heqa, heqb) (c, d) (c', d') (heqc, heqd).
hnf in *|-. simpl in *|-. now subst.
diff --git a/Util/ListComplements.v b/Util/ListComplements.v
index 80491a50d17e3c58e91aa98a06524ae49f382d6a..d394cf62d05fdb4e5a8cc7330e1e1fb4aeec49ed 100644
--- a/Util/ListComplements.v
+++ b/Util/ListComplements.v
@@ -24,15 +24,17 @@ Require Import List SetoidList.
Require Export SetoidPermutation.
Require Import Sorting.Permutation.
Require Import Bool.
-Require Import Arith.Div2 Lia PeanoNat.
+Require Import Lia PeanoNat.
Require Import Psatz.
Require Import SetoidDec.
Require Import Pactole.Util.Preliminary.
Require Import Pactole.Util.NumberComplements.
+(* this will become non default soon. *)
+Ltac Tauto.intuition_solver ::= auto with *.
Set Implicit Arguments.
-Arguments PermutationA {A}%type eqA%signature l1%list l2%list.
+Arguments PermutationA {A}%_type eqA%_signature l1%_list l2%_list.
(******************************)
@@ -52,6 +54,15 @@ intros x l Hin. induction l.
- destruct Hin. subst. now left. right. auto.
Qed. *)
+Lemma all_eq : forall (l : list A) (a1 : A), In a1 l ->length l = 1
+ -> forall a2 : A, In a2 l -> a2 = a1.
+Proof using .
+ intros * Hi1 H * Hi2. destruct l as [|h t].
+ rewrite (proj2 (length_zero_iff_nil _)) in H by reflexivity. discriminate H.
+ destruct t as [|h1 t]. cbn in Hi1, Hi2. destruct Hi1, Hi2. subst. reflexivity.
+ 1-3: contradiction. exfalso. eapply Nat.neq_succ_0, eq_add_S, H.
+Qed.
+
Lemma InA_Leibniz : forall (x : A) l, InA Logic.eq x l <-> In x l.
Proof using .
intros x l. split; intro Hl; induction l; inversion_clear Hl;
@@ -64,14 +75,14 @@ Proof using . intros [| x l]; auto. right. exists x. now left. Qed.
Lemma not_nil_In : forall l : list A, l <> nil -> exists x, In x l.
Proof using .
intros [| x l] Hl.
-- now elim Hl.
+- now contradiction Hl.
- exists x. now left.
Qed.
Lemma not_nil_last : forall l, l <> nil -> exists (a : A) l', l = l' ++ a :: nil.
Proof using .
intros l Hl. induction l.
-+ now elim Hl.
++ now contradiction Hl.
+ destruct l.
- exists a, nil. reflexivity.
- destruct (IHl ltac:(discriminate)) as [b [l'' Hl'']].
@@ -89,7 +100,7 @@ intros d x l Hin. induction l as [| e l].
+ inversion_clear Hin.
- exists 0, e. repeat split; trivial; simpl; lia.
- destruct IHl as [n [y [Hn [Hy Hl]]]]; trivial; [].
- apply Lt.lt_n_S in Hn. exists (S n), y. now repeat split.
+ exists (S n), y. repeat split; cbn; auto; lia.
Qed.
(* Already exists as [List.In_nth] but with a reversed argument order
@@ -106,7 +117,7 @@ Qed. *)
exists l1, exists l2, ~List.In x l1 /\ l = l1 ++ x :: l2.
Proof.
intros x l. induction l as [| a l]; intro Hin.
- now elim (List.in_nil Hin).
+ now contradiction (List.in_nil Hin).
destruct Hin.
subst. exists nil. exists l. intuition.
destruct (IHl H) as [l1 [l2 [Hnin Heq]]].
@@ -125,21 +136,21 @@ Qed.
Lemma hd_indep : forall l (d d' : A), l <> nil -> hd d l = hd d' l.
Proof using .
intros [| x l] d d' Hl.
-- now elim Hl.
+- now contradiction Hl.
- reflexivity.
Qed.
Lemma last_indep : forall l (d d' : A), l <> nil -> last l d = last l d'.
Proof using .
induction l as [| x l]; intros d d' Hl.
-- now elim Hl.
+- now contradiction Hl.
- destruct l; trivial. apply IHl. discriminate.
Qed.
Lemma hd_In : forall (d : A) l, l <> nil -> In (hd d l) l.
Proof using .
intros d [| x l] Hl.
-- now elim Hl.
+- now contradiction Hl.
- now left.
Qed.
@@ -149,7 +160,7 @@ Proof. intros x y Hxy l1 l2 Hl. now inv Hl; cbn. Qed.
Lemma last_In : forall l (d : A), l <> List.nil -> List.In (List.last l d) l.
Proof using .
induction l as [| x l]; intros d Hl.
-- now elim Hl.
+- now contradiction Hl.
- destruct l; try now left. right. apply IHl. discriminate.
Qed.
@@ -168,7 +179,7 @@ Proof using .
intros d l1 l2 Hl2. induction l1; simpl.
reflexivity.
assert (l1 ++ l2 <> nil). { intro Habs. apply Hl2. now destruct (app_eq_nil _ _ Habs). }
- destruct (l1 ++ l2). now elim H. assumption.
+ destruct (l1 ++ l2). now contradiction H. assumption.
Qed.
Lemma rev_nil : forall l : list A, rev l = nil <-> l = nil.
@@ -336,9 +347,9 @@ induction l.
+ inversion_clear Hfl.
rewrite InA_cons in *. destruct Hx as [Hx | Hx], Hy as [Hy | Hy].
- now rewrite Hx, Hy.
- - match goal with H : ~ InA _ _ _ |- _ => elim H end.
+ - match goal with H : ~ InA _ _ _ |- _ => contradiction H end.
rewrite <- Hx, Hxy, InA_map_iff; firstorder.
- - match goal with H : ~ InA _ _ _ |- _ => elim H end.
+ - match goal with H : ~ InA _ _ _ |- _ => contradiction H end.
rewrite <- Hy, <- Hxy, InA_map_iff; firstorder.
- auto.
Qed.
@@ -796,7 +807,7 @@ intros. split.
destruct lâ‚‚ as [| x'' [| y'' [| ? ?]]]; discriminate Hlength || clear Hlength.
destruct (IHperm1 _ _ _ _ ltac:(reflexivity) ltac:(reflexivity)) as [[H11 H12] | [H11 H12]],
(IHperm2 _ _ _ _ ltac:(reflexivity) ltac:(reflexivity)) as [[H21 H22] | [H21 H22]];
- rewrite H11, H12, <- H21, <- H22; intuition.
+ rewrite H11, H12, <- H21, <- H22; intuition auto with *.
+ intros [[Heq1 Heq2] | [Heq1 Heq2]]; rewrite Heq1, Heq2. reflexivity. now constructor 3.
Qed.
@@ -1122,7 +1133,7 @@ Lemma not_NoDupA : (forall x y, {eqA x y} + {~eqA x y} ) ->
Proof using HeqA.
intros eq_dec l. split; intro Hl.
* induction l.
- + elim Hl. now constructor.
+ + contradiction Hl. now constructor.
+ destruct (InA_dec eq_dec a l) as [Hin | Hnin].
- exists a. apply (PermutationA_split _) in Hin.
destruct Hin as [l' Hperm]. exists l'. now rewrite Hperm.
@@ -1284,7 +1295,7 @@ Qed.
Lemma inclA_dec : forall l1 l2, {inclA eqA l1 l2} + {~inclA eqA l1 l2}.
Proof.
induction l1 as [| x1 l1 Hrec]; intro l2.
-* left. abstract (intros x Habs; rewrite InA_nil in Habs; elim Habs).
+* left. abstract (intros x Habs; rewrite InA_nil in Habs; contradiction Habs).
* refine (match InA_dec eq_dec x1 l2 with
| left in_x => match Hrec l2 with
| left in_l => left _
@@ -1319,7 +1330,7 @@ Lemma not_inclA : forall l1 l2, ~inclA eqA l1 l2 <-> exists x, InA eqA x l1 /\ ~
Proof using HeqA eq_dec.
intros l1 l2. split; intro H.
* induction l1 as [| e l1].
- + elim H. intro. now rewrite InA_nil.
+ + contradiction H. intro. now rewrite InA_nil.
+ destruct (InA_dec eq_dec e l2).
- assert (Hincl : ~ inclA eqA l1 l2).
{ intro Hincl. apply H. intros x Hin. inversion_clear Hin.
@@ -1407,14 +1418,14 @@ intros a b Hab l. induction l as [| x l]; intros [| x' l'] Hl.
apply (PermutationA_cons_inv _), IHl in Hl. simpl.
rewrite Hl. repeat rewrite countA_occ_app. simpl.
destruct (eq_dec x a) as [Hx | Hx], (eq_dec y b) as [Hy | Hy]; try lia.
- - elim Hy. now rewrite <- Hxy, <- Hab.
- - elim Hx. now rewrite Hxy, Hab.
+ - contradiction Hy. now rewrite <- Hxy, <- Hab.
+ - contradiction Hx. now rewrite Hxy, Hab.
Qed.
Lemma countA_occ_alls_in : forall x n, countA_occ x (alls x n) = n.
Proof using HeqA.
intros x n. induction n; simpl; trivial.
-destruct (eq_dec x x) as [| Hneq]. now rewrite IHn. now elim Hneq.
+destruct (eq_dec x x) as [| Hneq]. now rewrite IHn. now contradiction Hneq.
Qed.
Lemma countA_occ_alls_out : forall x y n, ~eqA x y -> countA_occ y (alls x n) = 0%nat.
@@ -1425,11 +1436,11 @@ Proof using HeqA.
intros x l. induction l as [| a l]; simpl.
+ split; intro Habs.
- lia.
- - rewrite InA_nil in Habs. elim Habs.
+ - rewrite InA_nil in Habs. contradiction Habs.
+ destruct (eq_dec a x) as [Heq | Heq].
- split; intro; lia || now left.
- rewrite IHl. split; intro Hin; try now right; [].
- inversion_clear Hin; trivial. now elim Heq.
+ inversion_clear Hin; trivial. now contradiction Heq.
Qed.
Lemma countA_occ_length_le : forall l (x : A), countA_occ x l <= length l.
@@ -1485,7 +1496,7 @@ intros x l. induction l as [| a l]; intro n; simpl.
destruct n as [| n]; try lia; [].
f_equal. rewrite IHl. simpl in Hn. rewrite <- Heq in Hn at 1.
apply PermutationA_cons_inv in Hn; autoclass.
- + rewrite IHl. destruct (eq_dec x a); try (now elim Heq); [].
+ + rewrite IHl. destruct (eq_dec x a); try (now contradiction Heq); [].
rewrite <- PermutationA_middle; autoclass; [].
split; intro Hperm.
- now constructor.
@@ -1538,8 +1549,8 @@ Qed.
Lemma firstn_In : forall (l : list A) n, incl (firstn n l) l.
Proof using .
induction l; intros n x Hin.
-+ destruct n; elim Hin.
-+ destruct n; try now elim Hin. simpl in Hin. destruct Hin.
++ destruct n; contradiction Hin.
++ destruct n; try now contradiction Hin. simpl in Hin. destruct Hin.
- subst. now left.
- right. now apply IHl in H.
Qed.
@@ -1552,7 +1563,7 @@ Lemma firstn_add_tl_In : forall n l (x a : A),
Proof using .
induction n; intros l x a Hin; simpl in *.
- assumption.
-- destruct l as [| b l]; simpl in *; solve [elim Hin | intuition].
+- destruct l as [| b l]; simpl in *; solve [contradiction Hin | intuition].
Qed.
Lemma firstn_add_tl : forall l n (a : A), n <= length l -> firstn n (l ++ a :: nil) = firstn n l.
@@ -1577,8 +1588,8 @@ Qed.
Lemma skipn_In : forall (l : list A) n, incl (skipn n l) l.
Proof using .
induction l; intros n x Hin.
-+ destruct n; elim Hin.
-+ destruct n; try now elim Hin. simpl in Hin. apply IHl in Hin. now right.
++ destruct n; contradiction Hin.
++ destruct n; [apply Hin|]. simpl in Hin. apply IHl in Hin. now right.
Qed.
Lemma In_skipn : forall l l' (pt : A) n, n <= length l -> In pt (skipn n (l ++ pt :: l')).
@@ -1599,7 +1610,7 @@ Lemma skipn_add_tl_In : forall n l (x a : A), In x (skipn n l) -> In x (skipn n
Proof using .
induction n; intros l x a Hin; simpl in *.
- rewrite in_app_iff. now left.
-- destruct l as [| b l]; simpl in *; solve [elim Hin | auto].
+- destruct l as [| b l]; simpl in *; solve [contradiction Hin | auto].
Qed.
Lemma In_skipn_add : forall l (pt : A), In pt (skipn (Nat.div2 (length l)) (l ++ pt :: nil)).
@@ -1641,7 +1652,7 @@ Proof using . intros B f k. induction k; intros [| x l]; simpl; now try rewrite
Definition half1 (l : list A) := firstn (Nat.div2 (length l)) l.
Definition half2 (l : list A) := skipn (Nat.div2 (length l)) l.
-Lemma half1_length : forall l : list A, length (half1 l) = div2 (length l).
+Lemma half1_length : forall l : list A, length (half1 l) = Nat.div2 (length l).
Proof using .
intros.
unfold half1.
@@ -1651,10 +1662,10 @@ Proof using .
lia.
Qed.
-Corollary half2_length : forall l, length (half2 l) = length l - div2 (length l).
+Corollary half2_length : forall l, length (half2 l) = length l - Nat.div2 (length l).
Proof using . intros. unfold half2. now rewrite skipn_length. Qed.
-Corollary half2_even_length : forall l, Nat.Even (length l) -> length (half2 l) = div2 (length l).
+Corollary half2_even_length : forall l, Nat.Even (length l) -> length (half2 l) = Nat.div2 (length l).
Proof using . intros l H. unfold half2. rewrite skipn_length. apply even_div2 in H. lia. Qed.
Lemma merge_halves : forall l : list A, half1 l ++ half2 l = l.
@@ -1883,7 +1894,7 @@ Lemma max_list_ex : forall f l, l <> nil ->
exists pt, InA equiv pt l /\ max_list f l = Rmax (f pt) 0.
Proof using .
intros f l Hl. induction l as [| pt l].
-* now elim Hl.
+* now contradiction Hl.
* destruct (nil_or_In_dec l) as [? | Hin].
+ subst l. exists pt. split; eauto; now left.
+ assert (Hnil : l <> nil). { intro. subst. destruct Hin as [? []]. }
@@ -2006,7 +2017,7 @@ destruct (mem eq_dec x l) eqn:Hmem.
Qed.
Lemma odd_middle : forall l (d : A), Nat.Odd (length l) ->
- nth (div2 (length l)) (rev l) d = nth (div2 (length l)) l d.
+ nth (Nat.div2 (length l)) (rev l) d = nth (Nat.div2 (length l)) l d.
Proof using .
intros l d. generalize (eq_refl (length l)). generalize (length l) at 2 3 4 5. intro n. revert l.
induction n using nat_ind2; intros l Hl [m Hm].
@@ -2019,7 +2030,7 @@ induction n using nat_ind2; intros l Hl [m Hm].
rewrite app_length, Nat.add_comm in Hlen. simpl in Hlen. apply eq_add_S in Hlen. clear Hnil.
destruct n as [| n].
- clear -Hm. lia.
- - assert (div2 (S n) < length l'). { rewrite Hlen. apply Nat.lt_div2. lia. }
+ - assert (Nat.div2 (S n) < length l'). { rewrite Hlen. apply Nat.lt_div2. lia. }
repeat rewrite app_nth1; trivial. apply IHn.
assumption.
destruct m as [| m]. lia. exists m. lia.
@@ -2168,20 +2179,20 @@ Proof using . intros. now rewrite <- app_length, partition_Permutation. Qed.
Corollary filter_length : forall {A} f (l : list A),
length (filter f l) = length l - length (filter (fun x => negb (f x)) l).
Proof using .
-intros. apply plus_minus.
-rewrite <- (partition_length f), partition_filter.
-simpl. apply Nat.add_comm.
+intros. symmetry. apply Nat.add_sub_eq_l.
+rewrite <- (partition_length f l), partition_filter.
+cbn. apply Nat.add_comm.
Qed.
(* Definition remove_Perm_properR := remove_Perm_proper Rdec. *)
-Existing Instance Permutation_length_compat.
-Existing Instance Permutation_NoDup_compat.
+Global Existing Instance Permutation_length_compat.
+Global Existing Instance Permutation_NoDup_compat.
(* Existing Instance remove_Perm_properR. *)
-Existing Instance In_perm_compat.
-Existing Instance InA_impl_compat.
-Existing Instance InA_compat.
-Existing Instance InA_perm_compat.
-Existing Instance PermutationA_length.
-Existing Instance fold_left_start.
-Existing Instance fold_left_symmetry_PermutationA.
-Existing Instance PermutationA_map.
+Global Existing Instance In_perm_compat.
+Global Existing Instance InA_impl_compat.
+Global Existing Instance InA_compat.
+Global Existing Instance InA_perm_compat.
+Global Existing Instance PermutationA_length.
+Global Existing Instance fold_left_start.
+Global Existing Instance fold_left_symmetry_PermutationA.
+Global Existing Instance PermutationA_map.
diff --git a/Util/MMultiset/MMultisetExtraOps.v b/Util/MMultiset/MMultisetExtraOps.v
index 74734b588f51eb4c7a4d11f6ce305bef49524d04..df83277bc5452cb24281eb631e066c11b5237166 100644
--- a/Util/MMultiset/MMultisetExtraOps.v
+++ b/Util/MMultiset/MMultisetExtraOps.v
@@ -14,17 +14,20 @@ Require Import SetoidList.
Require Import RelationPairs.
Require Import SetoidDec.
+Require Import Pactole.Util.SetoidDefs.
Require Import Pactole.Util.MMultiset.Preliminary.
Require Import Pactole.Util.MMultiset.MMultisetInterface.
Require Import Pactole.Util.MMultiset.MMultisetFacts.
Set Implicit Arguments.
-Existing Instance multiplicity_compat.
+Global Existing Instance multiplicity_compat.
(* To have relation pairs unfolded *)
Arguments RelationPairs.RelProd {A} {B} RA RB _ _ /.
Arguments RelationPairs.RelCompFun {A} {B} R f a a' /.
+(* this will become non default soon. *)
+Ltac Tauto.intuition_solver ::= auto with *.
Section MMultisetExtra.
@@ -35,74 +38,74 @@ Section MMultisetExtra.
Hint Rewrite is_empty_spec nfilter_spec filter_spec npartition_spec_fst npartition_spec_snd : FMsetdec.
Hint Rewrite partition_spec_fst partition_spec_snd for_all_spec exists_spec : FMsetdec.
Hint Unfold In : FMsetdec.
-
+
(* Include (MMultisetExtraOps E M). *)
-
+
(** ** Function [remove_all] and its properties **)
-
+
(** Remove all copies of [x] from [m] *)
Definition remove_all x m := remove x m[x] m.
-
+
Lemma remove_all_same : forall x m, (remove_all x m)[x] = 0.
Proof using M. intros. unfold remove_all. rewrite remove_same. lia. Qed.
-
+
Lemma remove_all_other : forall x y m, y =/= x -> (remove_all x m)[y] = m[y].
Proof using M. intros. unfold remove_all. now rewrite remove_other. Qed.
-
+
Lemma remove_all_spec : forall x y m, (remove_all x m)[y] = if equiv_dec y x then 0 else m[y].
Proof using M. intros. unfold remove_all. msetdec. Qed.
-
+
Instance remove_all_compat : Proper (equiv ==> equiv ==> equiv) remove_all.
Proof using M. repeat intro. apply remove_compat; msetdec. Qed.
-
+
Instance remove_all_sub_compat : Proper (equiv ==> Subset ==> Subset) remove_all.
Proof using M. repeat intro. unfold remove_all. msetdec. Qed.
-
+
Lemma remove_all_In : forall x y m, In x (remove_all y m) <-> In x m /\ x =/= y.
Proof using M. intros. unfold remove_all. rewrite remove_In. intuition. msetdec. Qed.
-
+
Lemma remove_all_subset : forall x m, remove_all x m [<=] m.
Proof using M. intros x m y. unfold remove_all. msetdec. Qed.
-
+
Lemma remove_all_singleton_same : forall x n, remove_all x (singleton x n) == empty.
Proof using M. intros x n y. unfold remove_all. msetdec. Qed.
-
+
Lemma remove_all_singleton_other : forall x y n, y =/= x -> remove_all y (singleton x n) == singleton x n.
Proof using M. intros x y n Hxy z. unfold remove_all. msetdec. Qed.
-
+
Lemma remove_all_add_same : forall x n m, remove_all x (add x n m) == remove_all x m.
Proof using M. intros x n m y. unfold remove_all. msetdec. Qed.
-
+
Lemma remove_all_add_other : forall x y n m, x =/= y -> remove_all x (add y n m) == add y n (remove_all x m).
Proof using M. intros x y n m Hxy z. unfold remove_all. msetdec. Qed.
-
+
Lemma remove_all_remove : forall x n m, remove_all x (remove x n m) == remove_all x m.
Proof using M. intros x n m y. unfold remove_all. msetdec. Qed.
-
+
Lemma remove_remove_all : forall x n m, remove x n (remove_all x m) == remove_all x m.
Proof using M. intros x n m y. unfold remove_all. msetdec. Qed.
-
+
Lemma remove_all_remove_other : forall x y n m,
x =/= y -> remove_all y (remove x n m) == remove x n (remove_all y m).
Proof using M. intros x y n m Hxy z. unfold remove_all. msetdec. Qed.
-
+
Lemma remove_all_union : forall x mâ‚ mâ‚‚,
remove_all x (union mâ‚ mâ‚‚) == union (remove_all x mâ‚) (remove_all x mâ‚‚).
Proof using M. intros x n m y. unfold remove_all. msetdec. Qed.
-
+
Lemma remove_all_inter : forall x mâ‚ mâ‚‚,
remove_all x (inter mâ‚ mâ‚‚) == inter (remove_all x mâ‚) (remove_all x mâ‚‚).
Proof using M. intros x mâ‚ mâ‚‚ y. unfold remove_all. msetdec. Qed.
-
+
Lemma remove_all_diff : forall x mâ‚ mâ‚‚, remove_all x (diff mâ‚ mâ‚‚) == diff (remove_all x mâ‚) (remove_all x mâ‚‚).
Proof using M. intros x mâ‚ mâ‚‚ y. unfold remove_all. msetdec. Qed.
-
+
Lemma remove_all_diff2 : forall x mâ‚ mâ‚‚, remove_all x (diff mâ‚ mâ‚‚) == diff (remove_all x mâ‚) mâ‚‚.
Proof using M. intros x mâ‚ mâ‚‚ y. unfold remove_all. msetdec. Qed.
-
+
Lemma remove_all_lub : forall x mâ‚ mâ‚‚, remove_all x (lub mâ‚ mâ‚‚) == lub (remove_all x mâ‚) (remove_all x mâ‚‚).
Proof using M. intros x mâ‚ mâ‚‚ y. unfold remove_all. msetdec. Qed.
-
+
Lemma remove_all_for_all : forall f, compatb f ->
forall x m, for_all f (remove_all x m) = for_all (fun y n => if equiv_dec y x then true else f y n) m.
Proof using M.
@@ -117,7 +120,7 @@ Section MMultisetExtra.
- intros y y' Hy ? ? ?. subst. clear -Hf Hy.
destruct (equiv_dec y x), (equiv_dec y' x); try apply Hf; trivial; rewrite Hy in *; contradiction.
Qed.
-
+
Lemma remove_all_exists : forall f, compatb f ->
forall x m, exists_ f (remove_all x m) = exists_ (fun y n => if equiv_dec y x then false else f y n) m.
Proof using M.
@@ -132,47 +135,47 @@ Section MMultisetExtra.
- intros y y' Hy ? ? ?. subst. clear -Hf Hy.
destruct (equiv_dec y x), (equiv_dec y' x); try apply Hf; trivial; rewrite Hy in *; contradiction.
Qed.
-
+
Lemma remove_all_nfilter : forall f, compatb f ->
forall x m, nfilter f (remove_all x m) == remove_all x (nfilter f m).
Proof using M. repeat intro. unfold remove_all. msetdec. rewrite 2 Nat.sub_diag. now destruct_match. Qed.
-
+
Lemma remove_all_filter : forall f, Proper (equiv ==> Logic.eq) f ->
forall x m, filter f (remove_all x m) == remove_all x (filter f m).
Proof using M.
repeat intro. unfold remove_all. rewrite 2 filter_nfilter; trivial.
apply remove_all_nfilter. repeat intro. auto.
Qed.
-
+
Lemma remove_all_filter_false : forall f, Proper (equiv ==> Logic.eq) f ->
forall x m, f x = false -> filter f (remove_all x m) == filter f m.
Proof using M.
intros. rewrite remove_all_filter; trivial; []. apply remove_out.
rewrite filter_In; intuition; congruence.
Qed.
-
+
Lemma remove_all_npartition_fst : forall f, compatb f ->
forall x m, fst (npartition f (remove_all x m)) == remove_all x (fst (npartition f m)).
Proof using M. intros. rewrite 2 npartition_spec_fst; trivial; []. now apply remove_all_nfilter. Qed.
-
+
Lemma remove_all_npartition_snd : forall f, compatb f ->
forall x m, snd (npartition f (remove_all x m)) == remove_all x (snd (npartition f m)).
Proof using M.
intros f Hf x m. rewrite 2 npartition_spec_snd; trivial; [].
apply remove_all_nfilter. repeat intro. f_equal. now apply Hf.
Qed.
-
+
Lemma remove_all_partition_fst : forall f, Proper (equiv ==> Logic.eq) f ->
forall x m, fst (partition f (remove_all x m)) == remove_all x (fst (partition f m)).
Proof using M. intros. rewrite 2 partition_spec_fst; trivial; []. now apply remove_all_filter. Qed.
-
+
Lemma remove_all_partition_snd : forall f, Proper (equiv ==> Logic.eq) f ->
forall x m, snd (partition f (remove_all x m)) == remove_all x (snd (partition f m)).
Proof using M.
intros f Hf x m. rewrite 2 partition_spec_snd; trivial; [].
apply remove_all_filter. repeat intro. f_equal. now apply Hf.
Qed.
-
+
Lemma remove_all_elements : forall x m,
PermutationA eq_pair (elements (remove_all x m))
(removeA (fun x y => equiv_dec (fst x) (fst y)) (x, m[x]) (elements m)).
@@ -191,43 +194,43 @@ Section MMultisetExtra.
+ destruct_match.
- rewrite <- IHl. clear IHl.
split; [intros [Hxy Hin] | intro Hin]; intuition.
- inv Hin; try tauto; []. elim Hxy. hnf in *. simpl in *. now transitivity (fst e).
+ inv Hin; try tauto; []. contradiction Hxy. hnf in *. simpl in *. now transitivity (fst e).
- split; [intros [Hxy Hin] | intro Hin].
-- inv Hin; try (now left); []. right. intuition.
-- inv Hin; intuition.
lazymatch goal with H : _ =/= _, H1 : eq_pair _ e |- False =>
apply H; rewrite <- H1; intuition end.
Qed.
-
+
Lemma remove_all_support : forall x m,
PermutationA equiv (support (remove_all x m)) (removeA equiv_dec x (support m)).
Proof using M. intros. unfold remove_all. rewrite support_remove. destruct_match; reflexivity || lia. Qed.
-
+
Lemma remove_all_cardinal : forall x m, cardinal (remove_all x m) = cardinal m - m[x].
Proof using M. intros. unfold remove_all. now rewrite cardinal_remove, Nat.min_id. Qed.
-
+
Lemma remove_all_size_in : forall x m, In x m -> size (remove_all x m) = size m - 1.
Proof using M. intros. unfold remove_all. rewrite size_remove; trivial; []. destruct_match; lia. Qed.
-
+
Lemma remove_all_size_out : forall x m, ~In x m -> size (remove_all x m) = size m.
Proof using M. intros. unfold remove_all. now rewrite remove_out. Qed.
-
+
Lemma remove_all_as_filter : forall x m,
remove_all x m == filter (fun y => if equiv_dec y x then false else true) m.
Proof using M.
intros x m y. unfold remove_all. msetdec.
repeat intro. do 2 destruct_match; trivial; exfalso;
- match goal with H : _ =/= _ |- _ => apply H end; now etransitivity; eauto.
+ match goal with H : _ =/= _ |- _ => apply H end; now etransitivity; try eassumption; eauto.
Qed.
-
+
(** ** Function [map] and its properties **)
-
+
Definition map f m := fold (fun x n acc => add (f x) n acc) m empty.
-
+
Section map_results.
Variable f : elt -> elt.
Hypothesis Hf : Proper (equiv ==> equiv) f.
-
+
Global Instance map_compat : Proper (equiv ==> equiv) (map f).
Proof using Hf M.
intros mâ‚ mâ‚‚ Hm. unfold map. apply (fold_compat _ _).
@@ -236,7 +239,7 @@ Section MMultisetExtra.
- assumption.
- reflexivity.
Qed.
-
+
Lemma map_In : forall x m, In x (map f m) <-> exists y, x == (f y) /\ In y m.
Proof using Hf M.
intros x m. unfold In, map. apply fold_rect.
@@ -248,10 +251,10 @@ Section MMultisetExtra.
intros [? [? ?]]. msetdec.
- rewrite Hrec. split; intros [z [Heq ?]]; exists z; split; msetdec.
Qed.
-
+
Lemma map_empty : map f empty == empty.
Proof using M f. unfold map. now rewrite fold_empty. Qed.
-
+
Lemma map_add : forall x n m, map f (add x n m) == add (f x) n (map f m).
Proof using Hf M.
intros x n m y. destruct n.
@@ -263,7 +266,7 @@ Section MMultisetExtra.
- repeat intro. apply add_merge.
- lia.
Qed.
-
+
Lemma map_spec : forall x m,
(map f m)[x] = cardinal (nfilter (fun y _ => if equiv_dec (f y) x then true else false) m).
Proof using Hf M.
@@ -274,7 +277,7 @@ Section MMultisetExtra.
+ intros * Hin Hrec. rewrite map_add, nfilter_add; trivial. unfold g at 2. msetdec. rewrite cardinal_add. lia.
+ now rewrite map_empty, nfilter_empty, cardinal_empty, empty_spec.
Qed.
-
+
Global Instance map_sub_compat : Proper (Subset ==> Subset) (map f).
Proof using Hf M.
intro m. pattern m. apply ind; clear m.
@@ -282,32 +285,32 @@ Section MMultisetExtra.
+ intros m x n Hin Hn Hrec m' Hsub y.
assert (Hx : m[x] = 0). { unfold In in Hin. lia. }
rewrite <- (add_remove_cancel x m' (Hsub x)). do 2 rewrite (map_add _). msetdec.
- - apply Plus.plus_le_compat; trivial; [].
+ - apply Nat.add_le_mono; trivial; [].
repeat rewrite map_spec; trivial. apply add_subset_remove in Hsub.
apply cardinal_sub_compat, nfilter_sub_compat; solve [lia | repeat intro; msetdec].
- now apply Hrec, add_subset_remove.
+ intros ? _. rewrite map_empty. apply subset_empty_l.
Qed.
-
+
Lemma map_singleton : forall x n, map f (singleton x n) == singleton (f x) n.
Proof using Hf M.
intros x n y. destruct n.
+ repeat rewrite singleton_0. now rewrite map_empty.
+ unfold map. rewrite fold_singleton; repeat intro; msetdec.
Qed.
-
+
Lemma map_remove1 : forall x n m, n <= m[x] -> map f (remove x n m) == remove (f x) n (map f m).
Proof using Hf M.
intros x n m Hle. rewrite <- (add_remove_cancel _ _ Hle) at 2. now rewrite (map_add _), remove_add_cancel.
Qed.
-
+
Lemma map_remove2 : forall x n m,
m[x] <= n -> map f (remove x n m) == remove (f x) m[x] (map f m).
Proof using Hf M.
intros x n m Hle. rewrite <- (add_remove_id _ _ Hle) at 3.
now rewrite (map_add _), remove_add_cancel.
Qed.
-
+
Lemma fold_map_union : forall mâ‚ mâ‚‚, fold (fun x n acc => add (f x) n acc) mâ‚ mâ‚‚ == union (map f mâ‚) mâ‚‚.
Proof using Hf M.
intros mâ‚ mâ‚‚. apply fold_rect with (m := mâ‚).
@@ -315,7 +318,7 @@ Section MMultisetExtra.
+ now rewrite map_empty, union_empty_l.
+ intros * ? ? Heq. now rewrite Heq, map_add, union_add_comm_l.
Qed.
-
+
Theorem map_union : forall mâ‚ mâ‚‚, map f (union mâ‚ mâ‚‚) == union (map f mâ‚) (map f mâ‚‚).
Proof using Hf M.
intros mâ‚ mâ‚‚. unfold map at 1 2. rewrite (fold_union_additive _).
@@ -324,7 +327,7 @@ Section MMultisetExtra.
+ repeat intro. apply add_comm.
+ repeat intro. apply add_merge.
Qed.
-
+
Theorem map_inter : forall mâ‚ mâ‚‚, map f (inter mâ‚ mâ‚‚) [<=] inter (map f mâ‚) (map f mâ‚‚).
Proof using Hf M.
intros m1 m2 x. destruct (map f (inter m1 m2))[x] eqn:Hfx.
@@ -334,18 +337,18 @@ Section MMultisetExtra.
destruct Hin as [Hin1 Hin2]. rewrite <- Hfx, Heq. rewrite inter_spec.
apply Nat.min_glb; apply map_sub_compat; apply inter_subset_l + apply inter_subset_r.
Qed.
-
+
Theorem map_lub : forall mâ‚ mâ‚‚, lub (map f mâ‚) (map f mâ‚‚) [<=] map f (lub mâ‚ mâ‚‚).
Proof using Hf M.
intros m1 m2 x. destruct (lub (map f m1) (map f m2))[x] eqn:Hfx.
+ lia.
+ assert (Hin : In x (lub (map f m1) (map f m2))).
{ rewrite lub_spec in Hfx. rewrite lub_In. unfold In.
- destruct (Max.max_dec (map f m1)[x] (map f m2)[x]) as [Heq | Heq];
+ destruct (Nat.max_dec (map f m1)[x] (map f m2)[x]) as [Heq | Heq];
rewrite Heq in Hfx; left + right; lia. }
rewrite lub_In in Hin. rewrite <- Hfx.
destruct Hin as [Hin | Hin]; rewrite map_In in Hin; destruct Hin as [y [Heq Hin]]; rewrite Heq, lub_spec;
- apply Max.max_lub; apply map_sub_compat; apply lub_subset_l + apply lub_subset_r.
+ apply Nat.max_lub; apply map_sub_compat; apply lub_subset_l + apply lub_subset_r.
Qed.
Lemma map_from_elements :
@@ -384,7 +387,7 @@ Section MMultisetExtra.
+ intros m x n Hm Hn Hrec. rewrite map_add, size_add, size_add; trivial.
destruct (In_dec x m) as [Hin | Hin], (In_dec (f x) (map f m)) as [Hinf | Hinf].
- apply Hrec.
- - elim Hinf. rewrite map_In. now exists x.
+ - contradiction Hinf. rewrite map_In. now exists x.
- lia.
- lia.
+ now rewrite map_empty.
@@ -451,7 +454,7 @@ Section MMultisetExtra.
(map f (lub mâ‚ mâ‚‚))[x] = (map f mâ‚)[x].
Proof using Hf Hf2 M.
intros x mâ‚ mâ‚‚ Hle. destruct (map f mâ‚)[x] eqn:Heq1.
- - apply Le.le_n_0_eq in Hle. symmetry in Hle. destruct (map f (lub mâ‚ mâ‚‚))[x] eqn:Heq2; trivial.
+ - apply Nat.le_0_r in Hle. destruct (map f (lub mâ‚ mâ‚‚))[x] eqn:Heq2; trivial.
assert (Hin : In x (map f (lub mâ‚ mâ‚‚))). { unfold In. lia. }
rewrite map_In in Hin. destruct Hin as [y [Heq Hin]]. rewrite Heq in *. rewrite lub_In in Hin.
rewrite map_injective_spec in *. unfold In in *. destruct Hin; lia.
@@ -462,7 +465,7 @@ Section MMultisetExtra.
Theorem map_injective_lub : forall mâ‚ mâ‚‚, map f (lub mâ‚ mâ‚‚) == lub (map f mâ‚) (map f mâ‚‚).
Proof using Hf Hf2 M.
- intros mâ‚ mâ‚‚ x. rewrite lub_spec. apply Max.max_case_strong; intro Hle.
+ intros mâ‚ mâ‚‚ x. rewrite lub_spec. apply Nat.max_case_strong; intro Hle.
- now apply map_injective_lub_wlog.
- rewrite lub_comm. now apply map_injective_lub_wlog.
Qed.
@@ -685,7 +688,7 @@ Section MMultisetExtra.
+ rewrite Hxy. rewrite add_spec, Hx. msetdec.
+ rewrite add_other; auto. transitivity (max_mult m).
- apply Hrec.
- - apply Max.le_max_r.
+ - apply Nat.le_max_r.
* intro x. rewrite empty_spec. lia.
Qed.
@@ -700,7 +703,7 @@ Section MMultisetExtra.
+ destruct (equiv_dec z x) as [Hzx | Hzx].
- rewrite Hzx. rewrite add_spec, Hx. msetdec.
- rewrite add_other; trivial; [].
- transitivity (max_mult m); apply Hall || apply Max.le_max_r.
+ transitivity (max_mult m); apply Hall || apply Nat.le_max_r.
+ rewrite Hy. destruct (Compare_dec.le_dec n m[y]).
- exists y. rewrite max_r; trivial; [].
destruct (equiv_dec y x) as [Hyx | Hyx].
@@ -752,7 +755,7 @@ Section MMultisetExtra.
Proof using M.
intro m. split; intro Heq.
+ destruct (empty_or_In_dec m) as [? | [x Hin]]; trivial.
- elim (Nat.lt_irrefl 0). apply Nat.lt_le_trans with m[x].
+ contradiction (Nat.lt_irrefl 0). apply Nat.lt_le_trans with m[x].
- exact Hin.
- rewrite <- Heq. apply max_mult_spec_weak.
+ rewrite Heq. apply max_mult_empty.
@@ -793,7 +796,7 @@ Section MMultisetExtra.
-- assert (p = 0) by lia. subst. reflexivity.
-- repeat rewrite max_r; trivial; lia.
- rewrite <- Hle, Nat.add_comm. apply Nat.le_max_l.
- - apply Max.max_lub_r in Hle. rewrite max_l; lia.
+ - apply Nat.max_lub_r in Hle. rewrite max_l; lia.
- rewrite <- Hle. apply Nat.max_le_compat; lia.
+ rewrite add_other in *; trivial; [].
rewrite add_comm, max_mult_add; try (now rewrite add_In; intuition); [].
@@ -846,7 +849,7 @@ Section MMultisetExtra.
Nat.max (max_mult mâ‚) (max_mult mâ‚‚) <= max_mult (union mâ‚ mâ‚‚) <= max_mult mâ‚ + max_mult mâ‚‚.
Proof using M.
intros mâ‚ mâ‚‚. split.
- + apply Max.max_lub; f_equiv; intro; msetdec.
+ + apply Nat.max_lub; f_equiv; intro; msetdec.
+ apply max_mult_upper_bound.
intro. msetdec. apply Nat.add_le_mono; apply max_mult_spec_weak.
Qed.
@@ -909,7 +912,7 @@ Section MMultisetExtra.
match Nat.compare n (fst acc) with
| Lt => acc
| Eq => (fst acc, add x n (snd acc))
- | gt => (n, singleton x n)
+ | Gt => (n, singleton x n)
end.
Definition max m := snd (fold max_aux m (0, empty)).
@@ -1032,7 +1035,7 @@ Section MMultisetExtra.
- rewrite Nat.eqb_eq, max_mult_add; trivial.
rewrite Hm at 2.
rewrite add_empty, singleton_spec.
- msetdec. rewrite max_mult_empty. apply Max.max_0_r.
+ msetdec. rewrite max_mult_empty. apply Nat.max_0_r.
+ specialize (HI x'' Hx'').
destruct HI as [y Hy]. unfold max.
setoid_rewrite nfilter_In; auto; [].
@@ -1042,12 +1045,12 @@ Section MMultisetExtra.
destruct (Compare_dec.le_lt_dec n (m[y])).
- exists y. split.
-- msetdec.
- -- rewrite Nat.eqb_eq, Heq, add_other, Max.max_r; trivial.
+ -- rewrite Nat.eqb_eq, Heq, add_other, Nat.max_r; trivial.
Fail now msetdec. (* BUG? *) intro Habs. msetdec.
- exists x. split.
-- msetdec.
- -- rewrite Nat.eqb_eq, Max.max_l; try lia. msetdec.
- * intros x Hin. elim (In_empty Hin).
+ -- rewrite Nat.eqb_eq, Nat.max_l; try lia. msetdec.
+ * intros x Hin. contradiction (In_empty Hin).
Qed.
Lemma max_is_empty : forall m, max m == empty <-> m == empty.
@@ -1133,7 +1136,7 @@ Section MMultisetExtra.
split.
- red. cut (m[x]<>0). lia.
intro Habs. now rewrite Hx, max_mult_0 in Habs.
- - now rewrite Hx, <- EqNat.beq_nat_refl.
+ - rewrite Hx. apply Nat.eqb_refl.
Qed.
Lemma max_max_mult_ex : forall m, ~m == empty -> exists x, max_mult m = m[x].
@@ -1145,10 +1148,10 @@ Section MMultisetExtra.
+ exists x. rewrite Hm, add_empty. rewrite max_mult_singleton. msetdec.
+ assert (Hempty : m =/= empty) by now rewrite not_empty_In.
destruct (Hrec Hempty) as [max_m Hmax_m]. rewrite max_mult_add; trivial.
- destruct (Max.max_spec n (max_mult m)) as [[Hmax1 Hmax2] | [Hmax1 Hmax2]].
+ destruct (Nat.max_spec n (max_mult m)) as [[Hmax1 Hmax2] | [Hmax1 Hmax2]].
- exists max_m. msetdec.
- exists x. msetdec.
- * intro Habs. Fail now msetdec. (* BUG? *) now elim Habs.
+ * intro Habs. Fail now msetdec. (* BUG? *) now contradiction Habs.
Qed.
Lemma max_In_mult3 : forall m x, In x m -> (In x (max m) <-> m[x] = max_mult m).
@@ -1302,7 +1305,7 @@ Section MMultisetExtra.
forall m (i : A), eqA (fold f (max m) i) (fold (fun x n acc => if n =? max_mult m then f x n acc else acc) m i).
Proof using M.
intros A eqA HeqA f Hf Hf2 m i.
- rewrite fold_compat; autoclass; try apply max_simplified; try reflexivity; [].
+ rewrite fold_compat; try eassumption; try apply max_simplified; try reflexivity; [].
unfold simple_max. rewrite fold_nfilter; autoclass; [].
apply fold_extensionality_compat; autoclass.
- repeat intro. subst. now destruct_match; try apply Hf.
diff --git a/Util/MMultiset/MMultisetFacts.v b/Util/MMultiset/MMultisetFacts.v
index 1aa830e6a2dc6b27218d2b5f020ceb164c1a9c43..91f16a53e4d178d33699aa499b48d34862341811 100644
--- a/Util/MMultiset/MMultisetFacts.v
+++ b/Util/MMultiset/MMultisetFacts.v
@@ -13,9 +13,9 @@ Require Import Bool.
Require Import Lia PeanoNat.
Require Import PArith.
Require Import RelationPairs.
-(* Require Import Equalities. *)
Require Import SetoidList.
Require Import SetoidDec.
+Require Import Pactole.Util.SetoidDefs.
Require Import Pactole.Util.MMultiset.Preliminary.
Require Import Pactole.Util.MMultiset.MMultisetInterface.
@@ -24,6 +24,8 @@ Set Implicit Arguments.
Notation " x == y " := (equiv x y) (at level 70, no associativity).
Notation " x =/= y " := (complement equiv x y) (at level 70, no associativity).
+(* this will become non default soon. *)
+Ltac Tauto.intuition_solver ::= auto with *.
Section MMultisetFacts.
@@ -78,7 +80,7 @@ Section MMultisetFacts.
| H : ?x = ?x |- _ => clear H
| H : ?x == ?x |- _ => clear H
| H : ?x = ?y |- _ => subst x || rewrite H in *
- | Hneq : ?x =/= ?x |- _ => now elim Hneq
+ | Hneq : ?x =/= ?x |- _ => now contradiction Hneq
| Heq : @equiv elt _ ?x ?y |- _ => clear x Heq || rewrite Heq in *
| Heq : @equiv (multiset _) _ ?x ?y, Hin : context[?x] |- _ => rewrite Heq in Hin
| Heq : @equiv (multiset _) _ ?x ?y |- context[?x] => rewrite Heq
@@ -120,7 +122,7 @@ Section MMultisetFacts.
Lemma InA_pair_elt : forall x n p l, InA eq_pair (x, n) l -> InA eq_elt (x, p) l.
Proof using .
intros x n p l Hin. induction l as [| [y q] l].
- + rewrite InA_nil in Hin. elim Hin.
+ + rewrite InA_nil in Hin. contradiction Hin.
+ inversion_clear Hin.
- destruct H as [Heq ?]. now left.
- right. now apply IHl.
@@ -129,7 +131,7 @@ Section MMultisetFacts.
Lemma InA_elt_pair : forall x n l, InA eq_elt (x, n) l -> exists n', InA eq_pair (x, n') l.
Proof using .
intros x n l Hin. induction l as [| [y p] l].
- + rewrite InA_nil in Hin. elim Hin.
+ + rewrite InA_nil in Hin. contradiction Hin.
+ inversion_clear Hin.
- compute in H. exists p. left. now rewrite H.
- apply IHl in H. destruct H as [k Hin]. exists k. now right.
@@ -304,7 +306,7 @@ Section MMultisetFacts.
Proof using FMultisetsSpec. intros ? y ? ? ? Hs H. msetdec. specialize (Hs y). lia. Qed.
Global Instance add_sub_compat : Proper (equiv ==> le ==> Subset ==> Subset) add.
- Proof using FMultisetsSpec. repeat intro. msetdec. now apply Plus.plus_le_compat. Qed.
+ Proof using FMultisetsSpec. repeat intro. msetdec. now apply Nat.add_le_mono. Qed.
Global Instance singleton_sub_compat : Proper (equiv ==> le ==> Subset) singleton.
Proof using FMultisetsSpec. repeat intro. msetdec. Qed.
@@ -536,7 +538,7 @@ Section MMultisetFacts.
Proof using FMultisetsSpec. repeat intro. msetdec. Qed.
Lemma remove_singleton_other : forall x y n p, ~y == x -> remove y n (singleton x p) == singleton x p.
- Proof using FMultisetsSpec. repeat intro. msetdec. (* BUG?: saturate_Einequalities should work! *) now elim H. Qed.
+ Proof using FMultisetsSpec. repeat intro. msetdec. (* BUG?: saturate_Einequalities should work! *) now contradiction H. Qed.
Theorem elements_singleton : forall x n, n > 0 -> eqlistA eq_pair (elements (singleton x n)) ((x, n) :: nil).
Proof using FMultisetsSpec.
@@ -744,7 +746,7 @@ Section MMultisetFacts.
Lemma add_is_singleton : forall x y n p m, add x n m == singleton y p -> m == singleton y (p - n).
Proof using FMultisetsSpec.
intros x y n p m Hadd z. destruct n.
- + rewrite add_0 in Hadd. now rewrite Hadd, <- Minus.minus_n_O.
+ + rewrite add_0 in Hadd. now rewrite Hadd, Nat.sub_0_r.
+ assert (Heq := Hadd x). msetdec. rewrite <- (add_other y z (S n)), Hadd; trivial. msetdec.
Qed.
@@ -987,7 +989,7 @@ Section MMultisetFacts.
intros m1 m2. split; intro Hin.
+ intro x. destruct (In_dec x m1) as [Hin1 | Hin1], (In_dec x m2) as [Hin2 | Hin2]; auto.
assert (Habs : In x (inter m1 m2)). { rewrite inter_In. auto. }
- rewrite Hin in Habs. apply In_empty in Habs. elim Habs.
+ rewrite Hin in Habs. apply In_empty in Habs. contradiction Habs.
+ intro x. rewrite empty_spec, inter_spec. destruct (Hin x) as [[Hin1 Hin2] | [[Hin1 Hin2] | [Hin1 Hin2]]];
rewrite not_In in *; try rewrite Hin1; try rewrite Hin2; auto with arith.
Qed.
@@ -1195,7 +1197,7 @@ Section MMultisetFacts.
- specialize (Heq y). msetdec.
- specialize (Heq x). msetdec.
+ destruct Heq as [Hm1 [Hm2 Hn]]. rewrite Hm1, Hm2, lub_singleton_l, add_singleton_same. f_equiv. subst.
- rewrite singleton_same. apply Max.max_case_strong; lia.
+ rewrite singleton_same. apply Nat.max_case_strong; lia.
Qed.
Lemma remove_lub : forall x n m1 m2, remove x n (lub m1 m2) == lub (remove x n m1) (remove x n m2).
@@ -1275,7 +1277,7 @@ Section MMultisetFacts.
{ intros n Habs. rewrite elements_spec in Habs. destruct Habs. simpl in *. lia. }
destruct (mâ‚[x]) eqn:Hmâ‚. reflexivity.
specialize (Hin (S n)). rewrite <- Heq in Hin. rewrite elements_spec in Hin.
- elim Hin. split; simpl. assumption. lia.
+ contradiction Hin. split; simpl. assumption. lia.
- assert (Hin : InA eq_pair (x, S n) (elements mâ‚‚)). { rewrite elements_spec. split; simpl. assumption. lia. }
rewrite <- Heq in Hin. rewrite elements_spec in Hin. now destruct Hin.
+ intros [x n]. now rewrite Heq.
@@ -1398,7 +1400,7 @@ Section MMultisetFacts.
+ apply removeA_NoDupA; refine _. apply (NoDupA_strengthen _ (elements_NoDupA _)).
+ intros [y p]. rewrite removeA_InA_iff; refine _. rewrite elements_remove, elements_spec. simpl. intuition.
- destruct H1. contradiction.
- - destruct (equiv_dec y x) as [Heq | Heq]; auto. elim H1. split; msetdec.
+ - destruct (equiv_dec y x) as [Heq | Heq]; auto. contradiction H1. split; msetdec.
Qed.
Lemma elements_remove2 : forall x n m, n < m[x] ->
@@ -1409,7 +1411,7 @@ Section MMultisetFacts.
+ apply (NoDupA_strengthen _ (elements_NoDupA _)).
+ constructor.
- intro Habs. eapply InA_pair_elt in Habs. rewrite removeA_InA_iff in Habs; refine _.
- destruct Habs as [_ Habs]. now elim Habs.
+ destruct Habs as [_ Habs]. now contradiction Habs.
- eapply (NoDupA_strengthen subrelation_pair_elt). apply removeA_NoDupA, elements_NoDupA; refine _.
+ intros [y p]. rewrite elements_remove, elements_spec. simpl. intuition.
- rewrite H. left. split. compute. reflexivity. assumption.
@@ -1419,9 +1421,9 @@ Section MMultisetFacts.
+ inversion_clear H.
- left. destruct H0. repeat split; auto. hnf in *. simpl in *. lia.
- apply (InA_pair_elt (m[x])) in H0. rewrite Heq, removeA_InA in H0; refine _.
- destruct H0 as [_ Habs]. elim Habs. reflexivity.
+ destruct H0 as [_ Habs]. contradiction Habs. reflexivity.
+ right. split; trivial. inversion_clear H.
- - elim Heq. destruct H0. auto.
+ - contradiction Heq. destruct H0. auto.
- apply removeA_InA_weak in H0. rewrite elements_spec in H0. assumption. }
Qed.
@@ -1559,7 +1561,7 @@ Section MMultisetFacts.
+ apply add_is_singleton in Hin. specialize (Hin z). msetdec. destruct Hl as [_ Hl].
inversion_clear Hl. inversion_clear H0. simpl in *. lia. }
destruct Heq as [Heq1 Heq2]. destruct Hl as [Hl _]. inversion_clear Hl.
- elim H. left. compute. now transitivity x.
+ contradiction H. left. compute. now transitivity x.
- inversion_clear Hin. inversion_clear H0.
Qed.
@@ -1575,7 +1577,7 @@ Section MMultisetFacts.
Lemma from_elements_in : forall x n l, NoDupA eq_elt l -> InA eq_pair (x, n) l -> (from_elements l)[x] = n.
Proof using FMultisetsSpec.
intros x n l Hl Hin. induction l as [| [y p] l].
- + rewrite InA_nil in Hin. elim Hin.
+ + rewrite InA_nil in Hin. contradiction Hin.
+ simpl. inversion_clear Hin.
- destruct H as [Hx Hn]. compute in Hx, Hn. inversion Hl. now rewrite Hx, add_same, (@from_elements_out y p).
- inversion_clear Hl. rewrite add_other. now apply IHl.
@@ -1617,8 +1619,8 @@ Section MMultisetFacts.
Proof using FMultisetsSpec.
intros l x. induction l as [| [y p] l].
* simpl. split; intro Hin.
- + elim (In_empty Hin).
- + destruct Hin as [? [Hin _]]. rewrite InA_nil in Hin. elim Hin.
+ + contradiction (In_empty Hin).
+ + destruct Hin as [? [Hin _]]. rewrite InA_nil in Hin. contradiction Hin.
* simpl. rewrite add_In, IHl; trivial. split; intros Hin.
+ destruct Hin as [[? Heq] | [n [Hin Hn]]].
- exists p. split; try (left; split); auto; lia.
@@ -1653,10 +1655,10 @@ Section MMultisetFacts.
- subst. now repeat left.
- inversion_clear Hp.
-- destruct H; auto.
- -- inversion_clear Hnodup. elim H0. revert H. apply InA_pair_elt.
+ -- inversion_clear Hnodup. contradiction H0. revert H. apply InA_pair_elt.
+ rewrite add_other; trivial. destruct l as [| z l].
- simpl. rewrite empty_spec. intuition; try lia.
- inversion_clear H. destruct H0; try contradiction. rewrite InA_nil in H0. elim H0.
+ inversion_clear H. destruct H0; try contradiction. rewrite InA_nil in H0. contradiction H0.
- inversion_clear Hnodup. rewrite IHl; discriminate || trivial. intuition.
inversion_clear H1; trivial. destruct H2. contradiction.
Qed.
@@ -1686,7 +1688,7 @@ Section MMultisetFacts.
rewrite from_elements_cons, add_merge. rewrite elements_add_out.
- constructor; try reflexivity. apply is_elements_cons_inv in Hl'.
rewrite Hin, elements_from_elements; trivial. simpl.
- destruct pair_dec as [? | Habs]; try now elim Habs.
+ destruct pair_dec as [? | Habs]; try now contradiction Habs.
rewrite removeA_out; try reflexivity. intro Habs. apply Hout. revert Habs. apply InA_pair_elt.
- apply proj2 in Hl'. inversion_clear Hl'. simpl in *. lia.
- apply is_elements_cons_inv in Hl'. rewrite <- elements_In, elements_from_elements; eauto.
@@ -1781,7 +1783,7 @@ Section MMultisetFacts.
- rewrite <- fold_left_rev_right. rewrite rev_unit. simpl. rewrite <- Hfadd. f_equiv.
rewrite fold_left_rev_right, <- fold_spec. etransitivity.
symmetry. apply fold_add. lia. unfold In. rewrite remove_same. lia.
- rewrite add_remove1; trivial. now rewrite Minus.minus_diag, add_0.
+ rewrite add_remove1; trivial. now rewrite Nat.sub_diag, add_0.
- intros ? ? ? [? ?] [? ?] [Heq ?]. now apply Hf.
- intros [? ?] [? ?] ?. simpl. apply Hf2.
Qed.
@@ -1923,7 +1925,7 @@ Section MMultisetFacts.
+ pattern m. apply ind; clear m.
- intros m1 m2 Hm. setoid_rewrite Hm. reflexivity.
- intros m x n Hm Hn Hrec _. exists x. apply add_In. left. split; lia || reflexivity.
- - intro Habs. now elim Habs.
+ - intro Habs. now contradiction Habs.
+ intros [x Hin]. intro Habs. revert Hin. rewrite Habs. apply In_empty.
Qed.
@@ -1989,7 +1991,7 @@ Section MMultisetFacts.
destruct (equiv_dec z x).
exfalso. revert Hin. msetdec.
split; msetdec.
- destruct Hin. msetdec. (* BUG?: saturate_Einequalities shou work! *) now elim H0.
+ destruct Hin. msetdec. (* BUG?: saturate_Einequalities shou work! *) now contradiction H0.
- do 2 rewrite support_spec. unfold In in *. msetdec.
Qed.
@@ -2068,7 +2070,7 @@ Section MMultisetFacts.
intro m. split; intro Hm.
+ intro y. rewrite empty_spec, <- empty_spec with y. revert y. change (m == empty). rewrite <- elements_nil.
destruct (elements m) as [| [x n] l] eqn:Helt. reflexivity.
- simpl in Hm. elim (Nat.lt_irrefl 0). apply Nat.lt_le_trans with n.
+ simpl in Hm. contradiction (Nat.lt_irrefl 0). apply Nat.lt_le_trans with n.
- apply elements_pos with x m. rewrite Helt. now left.
- assert (Hn : m[x] = n). { eapply proj1. rewrite <- (elements_spec (x, n)), Helt. now left. }
rewrite <- Hn, <- Hm. apply cardinal_lower.
@@ -2104,10 +2106,10 @@ Section MMultisetFacts.
Theorem cardinal_remove : forall x n m, cardinal (remove x n m) = cardinal m - min n (m[x]).
Proof using FMultisetsSpec.
intros x n m. destruct (Compare_dec.le_dec n (m[x])) as [Hle | Hlt].
- + setoid_rewrite <- (add_0 x) at 3. erewrite <- (Minus.minus_diag n).
+ + setoid_rewrite <- (add_0 x) at 3. erewrite <- (Nat.sub_diag n).
rewrite <- (@add_remove1 x n n m), cardinal_add, min_l; trivial. lia.
+ assert (Hle : m[x] <= n) by lia.
- setoid_rewrite <- (add_0 x) at 3. erewrite <- Minus.minus_diag.
+ setoid_rewrite <- (add_0 x) at 3. erewrite <- Nat.sub_diag.
rewrite <- (@add_remove2 x _ n m Hle (Nat.le_refl _)), cardinal_add, min_r; trivial. lia.
Qed.
@@ -2119,7 +2121,7 @@ Section MMultisetFacts.
assert (n <= m'[x]). { transitivity (n + m[x]). lia. specialize (Hsub x). msetdec. }
assert (n <= cardinal m'). { etransitivity; try eassumption. apply cardinal_lower. }
apply add_subset_remove in Hsub. apply Hrec in Hsub. rewrite cardinal_remove in Hsub.
- etransitivity. apply Plus.plus_le_compat. reflexivity. apply Hsub. rewrite min_l; trivial. lia.
+ etransitivity. apply Nat.add_le_mono. reflexivity. apply Hsub. rewrite min_l; trivial. lia.
+ intros. rewrite cardinal_empty. lia.
Qed.
@@ -2129,11 +2131,11 @@ Section MMultisetFacts.
* intros m1 m1' Heq. split; intros Hle m2; rewrite Heq || rewrite <- Heq; apply Hle.
* intros m x n Hout Hn Hind m2. destruct (Compare_dec.le_lt_dec n (m2[x])) as [Hle | Hlt].
+ rewrite inter_add_l1; trivial. rewrite <- (add_remove_cancel Hle) at 2.
- do 3 rewrite cardinal_add. rewrite Min.plus_min_distr_l. apply Plus.plus_le_compat_l, Hind.
+ do 3 rewrite cardinal_add. rewrite Nat.add_min_distr_l. apply Nat.add_le_mono_l, Hind.
+ rewrite inter_add_l2; try lia.
transitivity (Init.Nat.min (cardinal (add x (m2[x]) m)) (cardinal m2)).
- rewrite <- (add_remove_cancel (reflexivity (m2[x]))) at 4.
- do 3 rewrite cardinal_add. rewrite Min.plus_min_distr_l. apply Plus.plus_le_compat_l.
+ do 3 rewrite cardinal_add. rewrite Nat.add_min_distr_l. apply Nat.add_le_mono_l.
rewrite remove_cap; try lia. apply Hind.
- do 2 rewrite cardinal_add. apply Nat.min_le_compat_r. lia.
* intro. rewrite inter_empty_l, cardinal_empty. lia.
@@ -2151,9 +2153,9 @@ Section MMultisetFacts.
replace (n + cardinal m - (n + cardinal(remove x n m2))) with (cardinal m - cardinal(remove x n m2)) by lia.
apply Hind.
- rewrite diff_add_l2; try lia. rewrite <- (add_remove_cancel (reflexivity (m2[x]))) at 1.
- do 3 rewrite cardinal_add. rewrite <- (@remove_cap x n); try lia.
- transitivity ((n - m2[x]) + (cardinal m - cardinal(remove x n m2))); try lia.
- apply Plus.plus_le_compat_l, Hind.
+ do 3 rewrite cardinal_add. rewrite <- (@remove_cap x n); try lia; [].
+ transitivity ((n - m2[x]) + (cardinal m - cardinal(remove x n m2))); try lia; [].
+ apply Nat.add_le_mono_l, Hind.
+ intro. now rewrite diff_empty_l, cardinal_empty.
Qed.
@@ -2166,9 +2168,9 @@ Section MMultisetFacts.
+ intros m1 m1' Heq. now setoid_rewrite Heq.
+ intros m x n Hout Hn Hind m2. rewrite lub_add_l. do 2 rewrite cardinal_add.
transitivity (n + Init.Nat.max (cardinal m) (cardinal (remove x n m2))).
- - rewrite <- Max.plus_max_distr_l. apply Nat.max_le_compat_l. rewrite <- (cardinal_add x).
+ - rewrite <- Nat.add_max_distr_l. apply Nat.max_le_compat_l. rewrite <- (cardinal_add x).
apply cardinal_sub_compat. intro. msetdec.
- - apply Plus.plus_le_compat_l, Hind.
+ - apply Nat.add_le_mono_l, Hind.
+ intro. now rewrite lub_empty_l, cardinal_empty.
Qed.
@@ -2221,7 +2223,7 @@ Section MMultisetFacts.
Lemma cardinal_from_elements : forall l,
cardinal (from_elements l) = List.fold_left (fun acc xn => snd xn + acc) l 0.
Proof using FMultisetsSpec.
- intro l. rewrite <- Plus.plus_0_l at 1. generalize 0. induction l as [| [x n] l]; intro p; simpl.
+ intro l. rewrite <- Nat.add_0_l at 1. generalize 0. induction l as [| [x n] l]; intro p; simpl.
- now rewrite cardinal_empty.
- rewrite cardinal_add, Nat.add_assoc. rewrite (Nat.add_comm p n). apply IHl.
Qed.
@@ -2263,7 +2265,7 @@ Section MMultisetFacts.
- inversion Hin.
- exists x. rewrite <- support_spec, Heq. now left.
+ destruct Hin as [x Hin]. destruct (size m) eqn:Hsize.
- - rewrite size_0 in Hsize. rewrite Hsize in Hin. elim (In_empty Hin).
+ - rewrite size_0 in Hsize. rewrite Hsize in Hin. contradiction (In_empty Hin).
- auto with arith.
Qed.
@@ -2281,7 +2283,7 @@ Section MMultisetFacts.
assert (Hnodup : NoDupA equiv (x :: l)). { rewrite <- Hin. apply support_NoDupA. }
(* XXX: why does [rewrite Hin] fails here? *)
rewrite removeA_Perm_compat; eauto; try reflexivity || apply setoid_equiv; []. rewrite Hin.
- simpl. destruct (equiv_dec x x) as [_ | Hneq]; try now elim Hneq.
+ simpl. destruct (equiv_dec x x) as [_ | Hneq]; try now contradiction Hneq.
inversion_clear Hnodup. now rewrite removeA_out.
Qed.
@@ -2291,7 +2293,7 @@ Section MMultisetFacts.
Qed.
Lemma size_union_lower : forall m1 m2, max (size m1) (size m2) <= size (union m1 m2).
- Proof using FMultisetsSpec. intros. apply Max.max_case; apply size_sub_compat; apply union_subset_l || apply union_subset_r. Qed.
+ Proof using FMultisetsSpec. intros. apply Nat.max_case; apply size_sub_compat; apply union_subset_l || apply union_subset_r. Qed.
(* TODO?: the most straigthforward way to express this would be by using set_union, hence requiring ListSetA. *)
Lemma size_union_upper : forall m1 m2, size (union m1 m2) <= size m1 + size m2.
@@ -2304,13 +2306,13 @@ Section MMultisetFacts.
Qed.
Lemma size_inter_upper : forall m1 m2, size (inter m1 m2) <= min (size m1) (size m2).
- Proof using FMultisetsSpec. intros. apply Min.min_case; apply size_sub_compat; apply inter_subset_l || apply inter_subset_r. Qed.
+ Proof using FMultisetsSpec. intros. apply Nat.min_case; apply size_sub_compat; apply inter_subset_l || apply inter_subset_r. Qed.
Lemma size_diff_upper : forall m1 m2, size (diff m1 m2) <= size m1.
Proof using FMultisetsSpec. intros. apply size_sub_compat, diff_subset. Qed.
Lemma size_lub_lower : forall m1 m2, max (size m1) (size m2) <= size (lub m1 m2).
- Proof using FMultisetsSpec. intros. apply Max.max_case; apply size_sub_compat; apply lub_subset_l || apply lub_subset_r. Qed.
+ Proof using FMultisetsSpec. intros. apply Nat.max_case; apply size_sub_compat; apply lub_subset_l || apply lub_subset_r. Qed.
Lemma size_lub_upper : forall m1 m2, size (lub m1 m2) <= size m1 + size m2.
Proof using FMultisetsSpec.
@@ -3542,7 +3544,7 @@ Section MMultisetFacts.
- right. exists y. now split.
+ symmetry. rewrite orb_false_iff. rewrite exists_false in *; trivial.
assert (Hxm : m[x] = 0) by (unfold In in Hin; lia). split.
- - destruct (f x n) eqn:Hfxn; trivial. elim Hm. exists x. split; msetdec.
+ - destruct (f x n) eqn:Hfxn; trivial. contradiction Hm. exists x. split; msetdec.
- intros [y [Hy Hfy]]. apply Hm. exists y. unfold In in *. split; msetdec.
Qed.
@@ -3556,7 +3558,7 @@ Section MMultisetFacts.
rewrite <- (@add_remove_cancel x), exists_add; trivial.
- apply (Hf2 _ _ (reflexivity x)) in Hle. simpl in Hle. rewrite Hall in Hle. simpl in Hle. now rewrite Hle.
- lia.
- - rewrite remove_In. intros [[_ Habs] | [Habs _]]; lia || now elim Habs.
+ - rewrite remove_In. intros [[_ Habs] | [Habs _]]; lia || now contradiction Habs.
+ setoid_rewrite Hall in Hrec. simpl in Hrec. apply Hrec. etransitivity; try eassumption. apply add_subset.
* intros. rewrite exists_empty; trivial. intuition.
Qed.
@@ -3583,14 +3585,14 @@ Section MMultisetFacts.
Proof using FMultisetsSpec Hf.
intros m1 m2. repeat rewrite exists_spec; trivial. intros [x [Hin Hfx]].
rewrite inter_spec in Hfx. rewrite inter_In in Hin. destruct Hin.
- destruct (Min.min_dec (m1[x]) (m2[x])) as [Hmin | Hmin];
+ destruct (Nat.min_dec (m1[x]) (m2[x])) as [Hmin | Hmin];
rewrite Hmin in Hfx; left + right; now exists x.
Qed.
Lemma exists_lub : forall m1 m2, exists_ f (lub m1 m2) = true -> exists_ f m1 = true \/ exists_ f m2 = true.
Proof using FMultisetsSpec Hf.
intros m1 m2. repeat rewrite exists_spec; trivial. intros [x [Hin Hfx]]. unfold In in *.
- rewrite lub_spec in Hin, Hfx. destruct (Max.max_dec (m1[x]) (m2[x])) as [Hmax | Hmax];
+ rewrite lub_spec in Hin, Hfx. destruct (Nat.max_dec (m1[x]) (m2[x])) as [Hmax | Hmax];
rewrite Hmax in Hin, Hfx; left + right; now exists x.
Qed.
@@ -3623,7 +3625,7 @@ Section MMultisetFacts.
- exists x. split.
++ rewrite add_In. left. split; lia || reflexivity.
++ rewrite not_In in Hm. rewrite add_same, Hm. simpl. now rewrite Hfxn.
- + intro Habs. elim Habs. intros x Hin. elim (In_empty Hin).
+ + intro Habs. contradiction Habs. intros x Hin. contradiction (In_empty Hin).
* intro Habs. destruct Hm as [x [Hin Hx]]. apply Habs in Hin. rewrite Hin in Hx. discriminate.
Qed.
@@ -3666,7 +3668,7 @@ Section MMultisetFacts.
+ destruct (for_all (fun (x : elt) (n : nat) => negb (f x n)) m) eqn:Hforall; trivial.
rewrite for_all_false_exists, exists_spec in Hforall; trivial.
destruct Hforall as [x [Hin Hfx]]. rewrite negb_involutive in Hfx.
- elim (@In_empty x). rewrite <- Hall, nfilter_In; auto.
+ contradiction (@In_empty x). rewrite <- Hall, nfilter_In; auto.
+ rewrite for_all_spec in Hall; trivial.
destruct (empty_or_In_dec (nfilter f m)) as [? | [x Hin]]; trivial.
rewrite nfilter_In in Hin; trivial. destruct Hin as [Hin Hfx]. apply Hall in Hin.
@@ -3758,7 +3760,7 @@ Ltac msetdec_step :=
| H : ?x = ?x |- _ => clear H
| H : ?x == ?x |- _ => clear H
| H : ?x = ?y |- _ => subst x || rewrite H in *
- | Hneq : ?x =/= ?x |- _ => now elim Hneq
+ | Hneq : ?x =/= ?x |- _ => now contradiction Hneq
| Heq : equiv ?x ?y |- _ => clear x Heq || rewrite Heq in *
| Heq : @equiv (multiset _) _ ?x ?y, Hin : context[?x] |- _ => rewrite Heq in Hin
| Heq : @equiv (multiset _) _ ?x ?y |- context[?x] => rewrite Heq
diff --git a/Util/MMultiset/MMultisetInterface.v b/Util/MMultiset/MMultisetInterface.v
index 32734f148ee0e9c3d06054a92e5d521fbc92c5ec..de832e4136f1b8697068ac1f1ce35d0e0619df4a 100644
--- a/Util/MMultiset/MMultisetInterface.v
+++ b/Util/MMultiset/MMultisetInterface.v
@@ -230,22 +230,22 @@ Class SizeSpec elt `(FMOps elt) := {
(** *** Full specification **)
Class FMultisetsOn elt `(Ops : FMOps elt) := {
- FullMultiplicitySpec :> MultiplicitySpec elt Ops;
- FullEmptySpec :> EmptySpec elt Ops;
- FullSingletonSpec :> SingletonSpec elt Ops;
- FullAddSpec :> AddSpec elt Ops;
- FullRemoveSpec :> RemoveSpec elt Ops;
- FullBinarySpec :> BinarySpec elt Ops;
- FullFoldSpec :> FoldSpec elt Ops;
- FullTestSpec: > TestSpec elt Ops;
- FullElementsSpec :> ElementsSpec elt Ops;
- FullSupportSpec :> SupportSpec elt Ops;
- FullChooseSpec :> ChooseSpec elt Ops;
- FullPartitionSpec :> PartitionSpec elt Ops;
- FullNpartitionSpec :> NpartitionSpec elt Ops;
- FullQuantifierSpec :> QuantifierSpec elt Ops;
- FullSizeSpec :> SizeSpec elt Ops;
- FullFilterSpec :> FilterSpec elt Ops}.
+ #[global] FullMultiplicitySpec :: MultiplicitySpec elt Ops;
+ #[global] FullEmptySpec :: EmptySpec elt Ops;
+ #[global] FullSingletonSpec :: SingletonSpec elt Ops;
+ #[global] FullAddSpec :: AddSpec elt Ops;
+ #[global] FullRemoveSpec :: RemoveSpec elt Ops;
+ #[global] FullBinarySpec :: BinarySpec elt Ops;
+ #[global] FullFoldSpec :: FoldSpec elt Ops;
+ #[global] FullTestSpec :: TestSpec elt Ops;
+ #[global] FullElementsSpec :: ElementsSpec elt Ops;
+ #[global] FullSupportSpec :: SupportSpec elt Ops;
+ #[global] FullChooseSpec :: ChooseSpec elt Ops;
+ #[global] FullPartitionSpec :: PartitionSpec elt Ops;
+ #[global] FullNpartitionSpec :: NpartitionSpec elt Ops;
+ #[global] FullQuantifierSpec :: QuantifierSpec elt Ops;
+ #[global] FullSizeSpec :: SizeSpec elt Ops;
+ #[global] FullFilterSpec :: FilterSpec elt Ops}.
(* Global Notation "s [=] t" := (eq s t) (at level 70, no associativity, only parsing). *)
diff --git a/Util/MMultiset/MMultisetWMap.v b/Util/MMultiset/MMultisetWMap.v
index 4b0bf92ec8a13e3ef5e1e4a307a445f3bc05d5e9..184c77860ef5314baa4bed947ff3df651dfb7e8a 100644
--- a/Util/MMultiset/MMultisetWMap.v
+++ b/Util/MMultiset/MMultisetWMap.v
@@ -20,6 +20,7 @@ Require Import Pactole.Util.FMaps.FMapInterface.
Require Import Pactole.Util.FMaps.FMapFacts.
Require Import Pactole.Util.MMultiset.Preliminary.
Require Import Pactole.Util.MMultiset.MMultisetInterface.
+Require Import Pactole.Util.SetoidDefs.
Require Import SetoidDec.
@@ -149,9 +150,9 @@ Proof using .
intros x y n m l Hl Hinx Hiny Heq. induction Hl as [| [z p] l]. inversion_clear Hiny.
inversion_clear Hinx; inversion_clear Hiny.
- compute in H0, H1. destruct H0 as [H0 ?], H1 as [H1 ?]. now subst p m.
-- compute in H0. destruct H0 as [H0 ?]. subst p. elim H.
+- compute in H0. destruct H0 as [H0 ?]. subst p. contradiction H.
apply eq_pair_elt_weak_In with y m. now transitivity x. assumption.
-- compute in H1. destruct H1 as [H1 ?]. subst p. elim H.
+- compute in H1. destruct H1 as [H1 ?]. subst p. contradiction H.
apply eq_pair_elt_weak_In with x n. now transitivity y; auto. assumption.
- now apply IHHl.
Qed.
@@ -255,7 +256,7 @@ Lemma multiplicity_out : forall x m, m[x] = 0 <-> find x m = None.
Proof using .
simpl. unfold m_multiplicity. intros x m. split; intro Hm.
+ destruct (find x m) eqn:Hfind.
- - elim (lt_irrefl 0). rewrite <- Hm at 2. now apply Pos2Nat.is_pos.
+ - contradiction (Nat.lt_irrefl 0). rewrite <- Hm at 2. now apply Pos2Nat.is_pos.
- reflexivity.
+ now rewrite Hm.
Qed.
@@ -322,21 +323,21 @@ Proof using MapSpec. split.
intros [n Habs]. now rewrite find_mapsto_iff, Hin in Habs.
* intros x s s'. unfold inter. simpl. destruct (find x s') eqn:Hin.
+ setoid_rewrite (fold_add (fun x n => min (m_multiplicity x s) n) x p s' (FMapInterface.empty _)); trivial; [|].
- - unfold multiplicity. simpl. unfold m_multiplicity. now rewrite empty_o, Hin, plus_0_r.
+ - unfold multiplicity. simpl. unfold m_multiplicity. now rewrite empty_o, Hin, Nat.add_0_r.
- intros ? ? Heq ? ? ?. subst. now rewrite Heq.
+ rewrite fold_add_out.
- - unfold multiplicity. simpl. unfold m_multiplicity. now rewrite Hin, Min.min_0_r, empty_o.
+ - unfold multiplicity. simpl. unfold m_multiplicity. now rewrite Hin, Nat.min_0_r, empty_o.
- intros [n Habs]. now rewrite find_mapsto_iff, Hin in Habs.
* intros x s s'. unfold diff. simpl. destruct (find x s) eqn:Hin.
+ setoid_rewrite (fold_add (fun x n => n - multiplicity x s') x p s (FMapInterface.empty _)); trivial.
- - unfold multiplicity. simpl. unfold m_multiplicity. now rewrite empty_o, Hin, plus_0_r.
+ - unfold multiplicity. simpl. unfold m_multiplicity. now rewrite empty_o, Hin, Nat.add_0_r.
- intros ? ? Heq ? ? ?. subst. now rewrite Heq.
+ rewrite fold_add_out.
- unfold multiplicity. simpl. unfold m_multiplicity. now rewrite Hin, empty_o.
- intros [n Habs]. now rewrite find_mapsto_iff, Hin in Habs.
* intros x s s'. unfold lub. simpl.
replace (max (m_multiplicity x s) (m_multiplicity x s'))
- with (m_multiplicity x s - m_multiplicity x s' + m_multiplicity x s') by (apply Max.max_case_strong; lia).
+ with (m_multiplicity x s - m_multiplicity x s' + m_multiplicity x s') by (apply Nat.max_case_strong; lia).
destruct (find x s) eqn:Hin.
+ erewrite (fold_add); eauto.
-unfold multiplicity. simpl. unfold m_multiplicity. now rewrite Hin.
@@ -368,7 +369,7 @@ Proof using MapSpec. split.
specialize (Hs x). cbn in Hs. unfold m_multiplicity in Hs.
destruct (find x s1), (find x s2);
solve [ apply Pos2Nat.inj in Hs; subst; reflexivity
- | elim (lt_irrefl 0); rewrite Hs at 2 || rewrite <- Hs at 2; apply Pos2Nat.is_pos
+ | contradiction (Nat.lt_irrefl 0); rewrite Hs at 2 || rewrite <- Hs at 2; apply Pos2Nat.is_pos
| split; intro; discriminate ].
+ assumption.
Qed.
@@ -383,7 +384,7 @@ assert (His_empty_spec : forall s, is_empty s = true <-> s == empty).
+ rewrite <- is_empty_iff. intros x n Habs.
rewrite find_mapsto_iff in Habs. specialize (H x).
unfold m_multiplicity in H. rewrite Habs, empty_o in H.
- apply (lt_irrefl 0). rewrite <- H at 2. apply Pos2Nat.is_pos. }
+ apply (Nat.lt_irrefl 0). rewrite <- H at 2. apply Pos2Nat.is_pos. }
split; trivial.
* intros s s'. unfold equal. simpl.
destruct (FMapInterface.equal Pos.eqb s s') eqn:Heq.
@@ -396,8 +397,8 @@ split; trivial.
unfold m_multiplicity in Habs. specialize (Habs x). simpl in Habs.
destruct (find x s) eqn:Hin1, (find x s') eqn:Hin2.
- f_equal. now apply Pos2Nat.inj.
- - elim (lt_irrefl 0). rewrite <- Habs at 2. now apply Pos2Nat.is_pos.
- - elim (lt_irrefl 0). rewrite Habs at 2. now apply Pos2Nat.is_pos.
+ - contradiction (Nat.lt_irrefl 0). rewrite <- Habs at 2. now apply Pos2Nat.is_pos.
+ - contradiction (Nat.lt_irrefl 0). rewrite Habs at 2. now apply Pos2Nat.is_pos.
- reflexivity.
* intros s s'. unfold subset. simpl.
cbn in His_empty_spec. rewrite His_empty_spec. clear His_empty_spec.
@@ -406,16 +407,16 @@ split; trivial.
+ intro x. destruct (find x s) eqn:Hin.
- cut (s[x] - s'[x] = 0). lia. rewrite <- diff_spec. simpl.
erewrite fold_add; eauto; [|].
- ++ unfold multiplicity. simpl. unfold m_multiplicity at 2. rewrite empty_o, plus_0_r.
+ ++ unfold multiplicity. simpl. unfold m_multiplicity at 2. rewrite empty_o, Nat.add_0_r.
specialize (Hle x). erewrite fold_add in Hle; eauto.
-- unfold multiplicity in Hle. simpl in Hle. unfold m_multiplicity at 2 in Hle.
- now rewrite empty_o, plus_0_r in Hle.
+ now rewrite empty_o, Nat.add_0_r in Hle.
-- intros ? ? Heq ? ? ?. subst. now rewrite Heq.
++ intros ? ? Heq ? ? ?. subst. now rewrite Heq.
- simpl. unfold m_multiplicity at 1. rewrite Hin. lia.
+ intro x. destruct (find x s) eqn:Hin.
- erewrite fold_add; eauto.
- -- unfold multiplicity. simpl. unfold m_multiplicity at 2. rewrite empty_o, plus_0_r.
+ -- unfold multiplicity. simpl. unfold m_multiplicity at 2. rewrite empty_o, Nat.add_0_r.
specialize (Hle x). simpl in Hle. unfold m_multiplicity at 1 in Hle. rewrite Hin in Hle. lia.
-- intros ? ? Heq ? ? ?. subst. now rewrite Heq.
- erewrite fold_add_out; eauto.
@@ -532,7 +533,7 @@ assert (Hs' : forall n, ~InA eq_key_elt (x, n) (FMapInterface.elements s)).
revert o. induction (FMapInterface.elements s); simpl; intros o Hin.
+ assumption.
+ apply IHl in Hin.
- - elim (Hs' (snd a)). left. split; simpl. now inversion Hin. reflexivity.
+ - contradiction (Hs' (snd a)). left. split; simpl. now inversion Hin. reflexivity.
- intros n Habs. apply (Hs' n). now right.
Qed.
@@ -590,7 +591,7 @@ induction (FMapInterface.elements s); simpl; intro s'; simpl in Hs.
-- clear. intros [] [] Hxy. now compute in *.
- inversion_clear Hdup. rewrite NoDupA_inj_map in H0; solve [ eassumption | autoclass | now intros [] [] ].
+ inversion_clear Hs.
- - elim Hneq. destruct H as [H1 H2]. split; trivial; [].
+ - contradiction Hneq. destruct H as [H1 H2]. split; trivial; [].
simpl in *. hnf in H2. cbn in H2. now rewrite H2, Pos2Nat.id.
- inversion_clear Hdup.
assert (Hxy : x =/= y) by (intro; eauto using eq_pair_elt_weak_In).
@@ -625,7 +626,7 @@ assert (Hnfilter : forall (f : elt -> nat -> bool) (x : elt) (s : multiset elt),
- unfold multiplicity. simpl. unfold m_multiplicity. rewrite empty_o. now destruct (f x 0).
- unfold In. simpl. lia.
+ rewrite nfilter_spec_In.
- - unfold multiplicity. simpl. unfold m_multiplicity at 3 4. now rewrite empty_o, Hin, plus_0_r.
+ - unfold multiplicity. simpl. unfold m_multiplicity at 3 4. now rewrite empty_o, Hin, Nat.add_0_r.
- assumption.
- unfold In. simpl. lia.
* split; trivial.
@@ -779,7 +780,7 @@ induction (FMapInterface.elements s); simpl; intros [s1 s2]; simpl in Hs.
- inversion_clear Hdup. rewrite NoDupA_inj_map in H0;
solve [ eassumption | autoclass | now intros [] [] ].
+ inversion_clear Hs.
- - elim Hneq. destruct H as [H1 H2]. split. assumption. hnf in *. simpl in *. now rewrite H2, Pos2Nat.id.
+ - contradiction Hneq. destruct H as [H1 H2]. split. assumption. hnf in *. simpl in *. now rewrite H2, Pos2Nat.id.
- inversion_clear Hdup.
assert (Hxy : x =/= y) by (intro; eauto using eq_pair_elt_weak_In).
rewrite IHl; try assumption. simpl. unfold npartition_fun.
@@ -853,7 +854,7 @@ induction (FMapInterface.elements s); simpl; intros [s1 s2]; simpl in Hs.
- inversion_clear Hdup. rewrite NoDupA_inj_map in H0;
solve [eassumption | autoclass | now intros [] [] ].
+ inversion_clear Hs.
- - elim Hneq. destruct H as [H1 H2]. split. assumption. hnf in *. simpl in *. now rewrite H2, Pos2Nat.id.
+ - contradiction Hneq. destruct H as [H1 H2]. split. assumption. hnf in *. simpl in *. now rewrite H2, Pos2Nat.id.
- inversion_clear Hdup.
assert (Hxy : x =/= y) by (intro; eauto using eq_pair_elt_weak_In).
rewrite IHl; try assumption. simpl.
@@ -889,7 +890,7 @@ Proof using MapSpec. split.
- simpl. unfold multiplicity. simpl. unfold m_multiplicity. rewrite empty_o. now destruct (f x 0).
- unfold In. simpl. lia.
+ setoid_rewrite npartition_spec_fst_In.
- - simpl. unfold m_multiplicity at 3 4. now rewrite empty_o, Hin, plus_0_r.
+ - simpl. unfold m_multiplicity at 3 4. now rewrite empty_o, Hin, Nat.add_0_r.
- assumption.
- unfold In. simpl. lia.
* intros f s Hf x. rewrite nfilter_spec.
@@ -899,7 +900,7 @@ Proof using MapSpec. split.
-- simpl. unfold m_multiplicity. rewrite empty_o. now destruct (f x 0).
-- unfold In. simpl. lia.
- rewrite npartition_spec_snd_In.
- -- simpl. unfold m_multiplicity at 2 4. rewrite empty_o, Hin, plus_0_r. now destruct (f x (S n)).
+ -- simpl. unfold m_multiplicity at 2 4. rewrite empty_o, Hin, Nat.add_0_r. now destruct (f x (S n)).
-- assumption.
-- unfold In. simpl. lia.
+ intros ? ? Heq ? ? ?. subst. now rewrite Heq.
diff --git a/Util/MMultiset/Preliminary.v b/Util/MMultiset/Preliminary.v
index 06b3973b8a77cf8f872be5526d48b47b166a9a06..9bc2afcf5fb6d992ee52e0063bb4dc4647648950 100644
--- a/Util/MMultiset/Preliminary.v
+++ b/Util/MMultiset/Preliminary.v
@@ -10,7 +10,6 @@
Require Import Lia.
-Require Import Arith.Div2.
Require Import Reals.
Require Import List.
Require Import Morphisms.
@@ -55,15 +54,15 @@ Definition transpose2 {A B C : Type} eqC (f : A -> B -> C -> C) :=
Definition additive2 {A B : Type} eqB (f : A -> nat -> B -> B) :=
forall x n p z, eqB (f x n (f x p z)) (f x (n + p) z).
-Instance compose_compat {A B C : Type} eqA eqB eqC : forall (f : A -> B) (g : B -> C),
+Global Instance compose_compat {A B C : Type} eqA eqB eqC : forall (f : A -> B) (g : B -> C),
Proper (eqA ==> eqB) f -> Proper (eqB ==> eqC) g -> Proper (eqA ==> eqC) (fun x => g (f x)).
Proof using . intros f g Hf Hg x y Heq. now apply Hg, Hf. Qed.
-Instance compose2_compat {A B C D : Type} eqA eqB eqC eqD : forall (f : A -> B) (g : B -> C -> D),
+Global Instance compose2_compat {A B C D : Type} eqA eqB eqC eqD : forall (f : A -> B) (g : B -> C -> D),
Proper (eqA ==> eqB) f -> Proper (eqB ==> eqC ==> eqD) g -> Proper (eqA ==> eqC ==> eqD) (fun x => g (f x)).
Proof using . intros f g Hf Hg x y Heq. now apply Hg, Hf. Qed.
-Instance compose3_compat {A B C D E : Type} eqA eqB eqC eqD eqE : forall (f : A -> B) (g : B -> C -> D -> E),
+Global Instance compose3_compat {A B C D E : Type} eqA eqB eqC eqD eqE : forall (f : A -> B) (g : B -> C -> D -> E),
Proper (eqA ==> eqB) f -> Proper (eqB ==> eqC ==> eqD ==> eqE) g ->
Proper (eqA ==> eqC ==> eqD ==> eqE) (fun x => g (f x)).
Proof using . intros f g Hf Hg x y Heq. now apply Hg, Hf. Qed.
@@ -101,7 +100,7 @@ Lemma NoDupA_2 : forall x y, ~eqA x y -> NoDupA eqA (x :: y :: nil).
Proof using .
intros x y Hdiff. constructor.
intro Habs. inversion_clear Habs.
- now elim Hdiff.
+ now contradiction Hdiff.
inversion H.
apply NoDupA_singleton.
Qed.
@@ -152,7 +151,7 @@ Proof using .
intros x l Hin. induction l; simpl.
+ reflexivity.
+ destruct (eq_dec x a).
- - elim Hin. now left.
+ - contradiction Hin. now left.
- f_equal. apply IHl. intro Habs. apply Hin. now right.
Qed.
@@ -162,7 +161,7 @@ Proof using HeqA.
intros x y l Hxy. induction l. reflexivity.
simpl. destruct (eq_dec y a).
subst. rewrite IHl. split; intro H. now right. inversion_clear H.
- elim Hxy. now transitivity a.
+ contradiction Hxy. now transitivity a.
assumption.
split; intro H; inversion_clear H; (now left) || right; now rewrite IHl in *.
Qed.
@@ -174,7 +173,7 @@ Proof using HeqA.
intros Hsub x y l. induction l as [| a l].
* split; intro Habs. inversion Habs. destruct Habs as [Habs _]. inversion Habs.
* simpl. destruct (eq_dec y a) as [Heq | Hneq].
- + rewrite IHl. intuition. inversion_clear H2. apply Hsub in H0. now elim H3; transitivity a. assumption.
+ + rewrite IHl. intuition. inversion_clear H2. apply Hsub in H0. now contradiction H3; transitivity a. assumption.
+ split; intro Hin.
- inversion_clear Hin.
split. now left. rewrite H. intro. now apply Hneq.
@@ -190,7 +189,7 @@ Proof using HeqA. apply (removeA_InA_iff_strong eq_dec). reflexivity. Qed.
Lemma removeA_InA_weak eq_dec : forall x y l, InA eqA' x (@removeA A eqA eq_dec y l) -> InA eqA' x l.
Proof using .
intros x y l Hin. induction l; simpl in *.
-+ rewrite InA_nil in Hin. elim Hin.
++ rewrite InA_nil in Hin. contradiction Hin.
+ destruct (eq_dec y a) as [Heq | Heq].
- auto.
- inversion_clear Hin; auto.
@@ -205,8 +204,8 @@ intros x y Hxy l l' ?. subst l'. induction l; simpl.
+ reflexivity.
+ destruct (eq_dec x a) as [Heqx | Hneqx], (eq_dec y a) as [Heqy | Hneqy].
- apply IHl.
- - elim Hneqy. now rewrite <- Hxy.
- - elim Hneqx. now rewrite Hxy.
+ - contradiction Hneqy. now rewrite <- Hxy.
+ - contradiction Hneqx. now rewrite Hxy.
- f_equal. apply IHl.
Qed.
@@ -217,17 +216,17 @@ intros x y ? l1 l2 Hl. subst. induction Hl.
+ constructor.
+ simpl. destruct (eq_dec x xâ‚) as [Heqâ‚ | Hneqâ‚], (eq_dec y xâ‚‚) as [Heqâ‚‚ | Hneqâ‚‚].
- assumption.
- - elim Hneqâ‚‚. now rewrite <- H, Heqâ‚.
- - elim Hneqâ‚. now rewrite H, Heqâ‚‚.
+ - contradiction Hneqâ‚‚. now rewrite <- H, Heqâ‚.
+ - contradiction Hneqâ‚. now rewrite H, Heqâ‚‚.
- now apply PermutationA_cons.
+ simpl. destruct (eq_dec x x0), (eq_dec y y0), (eq_dec y x0), (eq_dec x y0);
- try (now elim n; rewrite H) || (now elim n; rewrite <- H).
+ try (now contradiction n; rewrite H) || (now contradiction n; rewrite <- H).
- now erewrite removeA_eq_compat.
- constructor. reflexivity. now erewrite removeA_eq_compat.
- - elim n0. now rewrite <- H.
+ - contradiction n0. now rewrite <- H.
- constructor. reflexivity. now erewrite removeA_eq_compat.
- - elim n1. now rewrite H.
- - elim n0. now rewrite <- H.
+ - contradiction n1. now rewrite H.
+ - contradiction n0. now rewrite <- H.
- etransitivity. constructor 3. repeat constructor; reflexivity || now erewrite removeA_eq_compat.
+ constructor 4 with (removeA eq_dec y lâ‚‚).
- assumption.
@@ -243,7 +242,7 @@ Qed.
Corollary removeA_inside_in eq_dec :
forall (x : A) l1 l2, @removeA A eqA eq_dec x (l1 ++ x :: l2) = removeA eq_dec x l1 ++ removeA eq_dec x l2.
-Proof using HeqA. intros x ? ?. rewrite removeA_app. simpl. destruct (eq_dec x x) as [| Hneq]; trivial. now elim Hneq. Qed.
+Proof using HeqA. intros x ? ?. rewrite removeA_app. simpl. destruct (eq_dec x x) as [| Hneq]; trivial. now contradiction Hneq. Qed.
Corollary removeA_inside_out eq_dec : forall (x y : A) l1 l2,
~eqA x y -> @removeA A eqA eq_dec x (l1 ++ y :: l2) = removeA eq_dec x l1 ++ y :: removeA eq_dec x l2.
@@ -538,7 +537,7 @@ Lemma inclA_cons_inv : forall x y l1 l2,
Proof using HeqA.
intros x y l1 l2 Hx Heq Hincl z Hin.
assert (Hin' : InA eqA z (x :: l1)) by now right. apply Hincl in Hin'.
-inversion_clear Hin'; trivial. elim Hx. now rewrite Heq, <- H.
+inversion_clear Hin'; trivial. contradiction Hx. now rewrite Heq, <- H.
Qed.
Lemma inclA_length : forall l1 l2, NoDupA eqA l1 -> inclA eqA l1 l2 -> length l1 <= length l2.
@@ -556,7 +555,7 @@ Lemma not_NoDupA : (forall x y, {eqA x y} + {~eqA x y} ) ->
Proof using HeqA.
intros eq_dec l. split; intro Hl.
+ induction l.
- elim Hl. now constructor.
+ contradiction Hl. now constructor.
destruct (InA_dec eq_dec a l) as [Hin | Hnin].
exists a. apply PermutationA_split in Hin. destruct Hin as [l' Hperm]. exists l'. now rewrite Hperm.
destruct IHl as [x [l' Hperm]].
@@ -600,7 +599,10 @@ Qed.
Corollary filter_length : forall f (l : list A),
length (filter f l) = length l - length (filter (fun x => negb (f x)) l).
-Proof using . intros. apply plus_minus. rewrite <- (partition_length f), partition_filter. simpl. apply plus_comm. Qed.
+Proof using .
+intros. symmetry. apply Nat.add_sub_eq_l.
+rewrite <- (partition_length f l), partition_filter. cbn. apply Nat.add_comm.
+Qed.
Lemma map_cond_Permutation : forall (f : A -> bool) (gâ‚ gâ‚‚ : A -> B) l,
Permutation (map (fun x => if f x then gâ‚ x else gâ‚‚ x) l)
@@ -737,13 +739,13 @@ End List_results.
Lemma le_neq_lt : forall m n : nat, n <= m -> n <> m -> n < m.
-Proof using . intros n m Hle Hneq. now destruct (le_lt_or_eq _ _ Hle). Qed.
+Proof using . intros n m Hle Hneq. rewrite Nat.lt_eq_cases in Hle. intuition auto with *. Qed.
Lemma min_is_0 : forall n m, min n m = 0 <-> n = 0 \/ m = 0.
-Proof using . intros [| n] [| m]; intuition;discriminate. Qed.
+Proof using . intros [| n] [| m]; intuition auto with *. Qed.
Lemma max_is_0 : forall n m, max n m = 0 <-> n = 0 /\ m = 0.
-Proof using . intros [| n] [| m]; intuition; discriminate. Qed.
+Proof using . intros [| n] [| m]; intuition auto with *; discriminate. Qed.
Lemma Bleb_refl : forall x, Bool.le x x.
Proof using . intros [|]; simpl; auto. Qed.
diff --git a/Util/NumberComplements.v b/Util/NumberComplements.v
index cf3bd86a7e2bc9d38c676c2e9945827a56e0626f..ae022b589c53129db4c6cf69afbc98e03c6bcc2c 100644
--- a/Util/NumberComplements.v
+++ b/Util/NumberComplements.v
@@ -18,18 +18,14 @@
*)
(**************************************************************************)
-
-Require Import SetoidDec.
-Require Import Reals.
-Require Import Lia Psatz.
-
+Require Import Utf8 SetoidDec Reals Lia Psatz.
+Require Import Pactole.Util.SetoidDefs.
+Set Implicit Arguments.
(* ******************************** *)
(** * Results about real numbers **)
(* ******************************** *)
-
-Set Implicit Arguments.
Open Scope R_scope.
(* Should be in Reals from the the std lib! *)
@@ -46,21 +42,17 @@ intros x y. unfold Basics.flip. cbn. split; intro Hxy.
- destruct Hxy. now apply Rle_antisym.
Qed.
+Global Instance Rle_partialorder_equiv : PartialOrder equiv Rle := Rle_partialorder.
+
Global Instance Rlt_SO : StrictOrder Rlt.
Proof. split.
+ intro. apply Rlt_irrefl.
+ intros ? ? ?. apply Rlt_trans.
Qed.
-Lemma Rdec : forall x y : R, {x = y} + {x <> y}.
-Proof.
-intros x y. destruct (Rle_dec x y). destruct (Rle_dec y x).
- left. now apply Rle_antisym.
- right; intro; subst. contradiction.
- right; intro; subst. pose (Rle_refl y). contradiction.
-Qed.
-
-Instance R_EqDec : @EqDec R _ := Rdec.
+Global Instance R_EqDec : @EqDec R _ := Req_dec_T.
+(* #[export] *)
+Notation Rdec := R_EqDec.
Lemma Rdiv_le_0_compat : forall a b, 0 <= a -> 0 < b -> 0 <= a / b.
Proof. intros a b ? ?. now apply Fourier_util.Rle_mult_inv_pos. Qed.
@@ -110,7 +102,7 @@ Proof.
intros k r r'.
destruct (Rdec_bool (k + r) (k + r')) eqn:Heq1, (Rdec_bool r r') eqn:Heq2; trivial;
rewrite ?Rdec_bool_true_iff, ?Rdec_bool_false_iff in *.
-- elim Heq2. eapply Rplus_eq_reg_l; eassumption.
+- contradiction Heq2. eapply Rplus_eq_reg_l; eassumption.
- subst. auto.
Qed.
@@ -120,7 +112,7 @@ intros k r r' Hk.
destruct (Rdec_bool r r') eqn:Heq1, (Rdec_bool (k * r) (k * r')) eqn:Heq2; trivial;
rewrite ?Rdec_bool_true_iff, ?Rdec_bool_false_iff in *.
- subst. auto.
-- elim Heq1. eapply Rmult_eq_reg_l; eassumption.
+- contradiction Heq1. eapply Rmult_eq_reg_l; eassumption.
Qed.
Corollary Rdec_bool_plus_r : forall k r r', Rdec_bool (r + k) (r' + k) = Rdec_bool r r'.
@@ -220,7 +212,6 @@ Qed.
Close Scope R_scope.
-
(** * Results about integers **)
Lemma nat_compare_Eq_comm : forall n m, Nat.compare n m = Eq <-> Nat.compare m n = Eq.
@@ -247,15 +238,225 @@ Qed.
Lemma even_div2 : forall n, Nat.Even n -> Nat.div2 n + Nat.div2 n = n.
Proof.
intros n Hn. replace (Nat.div2 n + Nat.div2 n) with (2 * Nat.div2 n) by lia.
-rewrite <- Nat.double_twice. symmetry. apply Div2.even_double. now rewrite Even.even_equiv.
+rewrite <- Nat.double_twice. symmetry. now apply Nat.Even_double.
Qed.
-Lemma le_neq_lt : forall m n : nat, n <= m -> n <> m -> n < m.
-Proof. intros n m Hle Hneq. now destruct (le_lt_or_eq _ _ Hle). Qed.
+Lemma eq_0_lt_dec : ∀ n : nat, {n = 0} + {0 < n}.
+Proof using .
+ intros. destruct (le_lt_dec n 0) as [Hd | Hd].
+ left. apply Nat.le_0_r, Hd. right. apply Hd.
+Qed.
+
+Lemma sub_sub : ∀ m n p : nat, p <= n → m - (n - p) = m + p - n.
+Proof using . lia. Qed.
+
+Lemma sub_cancel_l : ∀ p m n : nat, m < p -> p - m = p - n <-> m = n.
+Proof using . lia. Qed.
+
+Lemma add_mul_lt : ∀ a b c d : nat, a < d -> b < c -> d * b + a < d * c.
+Proof using . nia. Qed.
+
+Lemma le_neq_lt : forall m n : nat, n <= m -> n ≠m -> n < m.
+Proof using . lia. Qed.
+
+Lemma lt_sub_lt_add_l : ∀ n m p : nat, m <= n -> n < m + p -> n - m < p.
+Proof using . lia. Qed.
+
+Lemma lt_sub_lt_add_r : ∀ n m p : nat, p <= n -> n < m + p -> n - p < m.
+Proof using . lia. Qed.
+
+Lemma sub_le_mono : ∀ n m p q : nat, n <= m -> p <= q -> n - q <= m - p.
+Proof using . lia. Qed.
+
+Lemma lt_sub : ∀ n m : nat, 0 < n -> 0 < m -> n - m < n.
+Proof using . lia. Qed.
+
+Lemma sub_lt_mono : ∀ n m p q : nat, p <= q -> p < m -> n < m -> n - q < m - p.
+Proof using . lia. Qed.
+
+(* Statement improvable? Weaker precondition than m <= p? *)
+Lemma sub_lt_mono_l : ∀ m n p : nat, m <= p -> n < m -> p - m < p - n.
+Proof using . lia. Qed.
+
+Lemma add_sub_le_sub_add : ∀ n m p : nat, n + m - p <= n - p + m.
+Proof using . lia. Qed.
+
+Lemma S_pred2 : ∀ n : nat, 1 < n -> n = S (S (Nat.pred (Nat.pred n))).
+Proof using . lia. Qed.
+
+Lemma S_pred3 : ∀ n : nat,
+ 2 < n -> n = S (S (S (Nat.pred (Nat.pred (Nat.pred n))))).
+Proof using . lia. Qed.
+
+Lemma mod_bounded_diffI : ∀ p m n : nat, p ≠0 -> m <= n
+ -> n - m < p -> m mod p = n mod p -> m = n.
+Proof using .
+intros * Hne Hle Hsu Heq.
+rewrite (Nat.div_mod m p), (Nat.div_mod n p), Heq; trivial; [].
+apply Nat.add_cancel_r, Nat.mul_cancel_l; trivial; [].
+apply Nat.le_antisymm.
++ apply Nat.Div0.div_le_mono. exact Hle.
++ apply Nat.sub_0_le, Nat.lt_1_r. rewrite (Nat.mul_lt_mono_pos_l p); try lia; [].
+ rewrite Nat.mul_1_r, Nat.mul_sub_distr_l.
+ assert (Hmod : ∀ x y : nat, y ≠0 -> x - x mod y = y * (x / y)).
+ { intros. rewrite Nat.Div0.mod_eq; trivial; [].
+ cut (y * (x / y) <= x); try lia; [].
+ rewrite (Nat.div_mod_eq x y) at 2. assert (HH := Nat.Div0.mod_le x y). lia. }
+ setoid_rewrite <- Hmod; lia.
+Qed.
+
+Lemma between_1 : ∀ m : nat, m <= m < m +1.
+Proof using . lia. Qed.
+
+Lemma between_neq_0 : ∀ n p m : nat, p <= m < p + n -> n ≠0.
+Proof using . lia. Qed.
+
+Lemma between_addn : ∀ n1 n2 p1 p2 m1 m2 : nat, p1 <= m1 < p1 + n1
+ -> p2 <= m2 < p2 + n2 -> p1 + p2 <= m1 + m2 < p1 + p2 + Nat.pred (n1 + n2).
+Proof using . lia. Qed.
+
+Lemma between_subn : ∀ n1 n2 p1 p2 m1 m2 : nat, p1 <= m1 < p1 + n1
+ -> p2 <= m2 < p2 + n2 -> p1 - Nat.pred (p2 + n2)
+ <= m1 - m2 < p1 - Nat.pred (p2 + n2) + Nat.pred (n1 + n2).
+Proof using . lia. Qed.
+
+Lemma bounded_diff_between : ∀ P : nat -> nat -> Prop, Symmetric P
+ -> ∀ n : nat, (∀ m1 m2 : nat, m1 <= m2 -> m2 - m1 < n -> P m1 m2)
+ <-> ∀ (p m1 m2: nat), p <= m1 < p + n -> p <= m2 < p + n -> P m1 m2.
+Proof using .
+intros * HS *. split.
++ intros H * [H11 H12] [H21 H22].
+ destruct (le_ge_dec m1 m2) as [Hd | Hd]; [| symmetry]; apply H; trivial; lia.
++ intros H m1 m2 Hle Hlt. apply (H m1); split; lia.
+Qed.
+
+Lemma inj_sym : ∀ (A B : Type) (SA : Setoid A) (SB : Setoid B) (f : A -> B),
+ Symmetric (λ a1 a2, f a1 == f a2 -> a1 == a2).
+Proof using .
+ intros * a1 a2 H1 H2. symmetry. apply H1. symmetry. exact H2.
+Qed.
+
+Lemma mod_betweenI : ∀ p n m1 m2 : nat, p <= m1 < p + n -> p <= m2 < p + n
+ -> m1 mod n = m2 mod n -> m1 = m2.
+Proof using .
+ intros * H. pose proof (between_neq_0 _ _ _ H) as Hn. revert m1 m2 H.
+ eapply (bounded_diff_between _ (inj_sym _ _ (eq_setoid nat) (eq_setoid nat)
+ (λ x, x mod n))). intros * H1 H2 H3. eapply mod_bounded_diffI. all: eassumption.
+Qed.
+
+Lemma between_muln : ∀ p n m : nat, n * p <= m < n * p + n -> m / n = p.
+Proof using . intros * []. symmetry. apply Nat.div_unique with (m - n * p); nia. Qed.
+
+Lemma mod_le_between_compat : ∀ p n m1 m2 : nat, n * p <= m1 < n * p + n
+ -> n * p <= m2 < n * p + n -> m1 <= m2 -> m1 mod n <= m2 mod n.
+Proof using .
+ intros * H1 H2 Hle. erewrite 2 Nat.Div0.mod_eq, 2 between_muln,
+ Nat.add_le_mono_r, 2 Nat.sub_add;try assumption;try eassumption.
+ - apply H2.
+ - apply H1.
+Qed.
+
+Lemma mod_lt_between_compat : ∀ p n m1 m2 : nat, n * p <= m1 < n * p + n
+ -> n * p <= m2 < n * p + n -> m1 < m2 -> m1 mod n < m2 mod n.
+Proof using .
+ intros * H1 H2 Hlt. erewrite 2 Nat.Div0.mod_eq, 2 between_muln,
+ Nat.add_lt_mono_r, 2 Nat.sub_add;try assumption; try eassumption.
+ - apply H2.
+ - apply H1.
+Qed.
+
+Lemma divide_neq : ∀ a b : nat, b ≠0 -> Nat.divide a b -> a ≠0.
+Proof using . intros * Hn Hd H. subst. apply Hn, Nat.divide_0_l, Hd. Qed.
+
+Lemma divide_div_neq : ∀ a b : nat, b ≠0 -> Nat.divide a b -> b / a ≠0.
+Proof using .
+ intros * Hn Hd H. apply Hn. unshelve erewrite (Nat.div_mod b a),
+ (proj2 (Nat.Lcm0.mod_divide b a)), Nat.add_0_r, H; try eassumption.
+ - apply Nat.mul_0_r.
+ - eapply divide_neq; eassumption.
+ Qed.
+
+Lemma addn_muln_divn : ∀ n q1 q2 r1 r2 : nat, n ≠0 -> r1 < n -> r2 < n
+ -> n * q1 + r1 = n * q2 + r2 -> q1 = q2 ∧ r1 = r2.
+Proof using .
+ intros * Hn H1 H2 H. apply Nat.div_unique in H as H'. rewrite Nat.mul_comm,
+ Nat.div_add_l, Nat.div_small, Nat.add_0_r in H'. subst. split. reflexivity.
+ eapply Nat.add_cancel_l. all: eassumption.
+Qed.
+
+Lemma divide_mul : ∀ a b : nat, b ≠0 -> Nat.divide a b -> b = a * (b / a).
+Proof using .
+ intros * Hn Hd. erewrite (Nat.div_mod b a) at 1.
+ unshelve erewrite (proj2 (Nat.Lcm0.mod_divide b a )); try eassumption.
+ - apply Nat.add_0_r.
+ - eapply divide_neq;eassumption.
+Qed.
+
+Lemma divide_mod :
+ ∀ a b c : nat, b ≠0 -> Nat.divide a b -> (c mod b) mod a = c mod a.
+Proof using .
+ intros * Hn Hd. rewrite (divide_mul a b), Nat.Div0.mod_mul_r, Nat.mul_comm,
+ Nat.Div0.mod_add; try assumption.
+ apply Nat.Div0.mod_mod.
+Qed.
+
+Lemma mul_add : ∀ a b : nat,
+ b ≠0 -> a * b = a + Nat.pred b * a.
+Proof using .
+ intros * Hb. destruct (Nat.eq_dec a 0) as [?|Ha].
+ - subst. rewrite Nat.mul_0_r. apply Nat.mul_0_l.
+ - rewrite <- (Nat.mul_1_l a) at 2. rewrite <- Nat.mul_add_distr_r,
+ Nat.add_1_l, Nat.succ_pred. apply Nat.mul_comm. apply Hb.
+Qed.
+
+Lemma pred_mul_add : ∀ a b : nat,
+ b ≠0 -> Nat.pred (a * b) = Nat.pred a + Nat.pred b * a.
+Proof using .
+ intros * Hb. destruct (Nat.eq_dec a 0) as [?|Ha].
+ - subst. rewrite Nat.mul_0_r. apply Nat.mul_0_l.
+ - rewrite mul_add by apply Hb. symmetry. apply Nat.add_pred_l, Ha.
+Qed.
+
+Lemma lt_pred_mul : ∀ a b c d : nat,
+ a < b -> c < d -> Nat.pred ((S a) * (S c)) < b * d.
+Proof using .
+ intros * Hab Hcd. erewrite <- Nat.le_succ_l, Nat.lt_succ_pred.
+ - apply Nat.mul_le_mono. apply Hab. apply Hcd.
+ - apply Nat.mul_pos_pos. all: apply Nat.lt_0_succ.
+Qed.
+
+Fact mul_le_lt_compat : ∀ (n m p q : nat),
+ 0 < n -> n <= m -> p < q -> n * p < m * q.
+Proof using.
+ intros.
+ apply Nat.le_lt_trans with (m * p).
+ - apply Nat.mul_le_mono_r; assumption.
+ - apply Nat.mul_lt_mono_pos_l; try assumption.
+ apply Nat.lt_le_trans with n; assumption.
+Qed.
+
+Corollary mul_lt_compat : ∀ (m p q : nat), 0 < m -> p < q -> p < m * q.
+Proof using.
+ intros.
+ rewrite <- (Nat.mul_1_l p).
+ apply (@mul_le_lt_compat 1); try assumption.
+ apply Nat.lt_0_1.
+Qed.
+
+Lemma neq_lt : ∀ a b : nat, a < b -> b ≠a.
+Proof using .
+ intros * Hlt Heq. apply (Nat.lt_irrefl a). rewrite <- Heq at 2. exact Hlt.
+Qed.
+
+Lemma lt_pred : ∀ a b : nat, a < b -> Nat.pred b < b.
+Proof using . lia. Qed.
+
+Lemma neq_pred : ∀ a b c : nat, a < b -> b < c -> Nat.pred c ≠a.
+Proof using . lia. Qed.
Open Scope Z.
-Instance Z_EqDec : @EqDec Z _ := Z.eq_dec.
+Global Instance Z_EqDec : @EqDec Z _ := Z.eq_dec.
Lemma Zincr_mod : forall k n, 0 < n ->
(k + 1) mod n = k mod n + 1 \/ (k + 1) mod n = 0 /\ k mod n = n - 1.
@@ -297,3 +498,115 @@ Lemma Zmin_bounds : forall n m, n < m -> Z.min n (m - n) <= m / 2.
Proof. intros. apply Z.min_case_strong; intro; apply Zdiv.Zdiv_le_lower_bound; lia. Qed.
Close Scope Z.
+
+Class ltc (l u : nat) := lt_l_u : l < u.
+Infix "<c" := ltc (at level 70, no associativity).
+
+Section ltc_l_u.
+
+Context {l u : nat} {ltc_l_u : l <c u}.
+
+Lemma neq_u_l : u ≠l.
+Proof using ltc_l_u. apply neq_lt, lt_l_u. Qed.
+
+Lemma le_l_pred_u : l <= Nat.pred u.
+Proof using ltc_l_u. apply Nat.lt_le_pred, lt_l_u. Qed.
+
+Lemma lt_pred_u : Nat.pred u < u.
+Proof using ltc_l_u. eapply lt_pred, lt_l_u. Qed.
+
+Lemma S_pred_u : S (Nat.pred u) = u.
+Proof using ltc_l_u. eapply Nat.lt_succ_pred, lt_l_u. Qed.
+
+End ltc_l_u.
+
+Section ltc_s_u.
+
+Context {l u : nat} {ltc_l_u : l <c u}.
+
+Lemma lt_s_u : ∀ s : nat, s <= l -> s < u.
+Proof using ltc_l_u.
+ intros * H. eapply Nat.le_lt_trans. exact H. exact lt_l_u.
+Qed.
+
+Lemma lt_s_pred_u : ∀ s : nat, s < l -> s < Nat.pred u.
+Proof using ltc_l_u.
+ intros * H. eapply Nat.lt_le_trans. exact H. exact le_l_pred_u.
+Qed.
+
+Lemma le_s_pred_u : ∀ s : nat, s <= l -> s <= Nat.pred u.
+Proof using ltc_l_u.
+ intros * H. eapply Nat.le_trans. exact H. exact le_l_pred_u.
+Qed.
+
+Lemma neq_pred_u_s : ∀ s : nat, s < l -> Nat.pred u ≠s.
+Proof using ltc_l_u. intros * H. eapply neq_pred. apply H. apply lt_l_u. Qed.
+
+Lemma lt_S_l_u : u ≠S l -> S l < u.
+Proof using ltc_l_u.
+ intros H. apply le_neq_lt. apply ltc_l_u. apply not_eq_sym, H.
+Qed.
+
+Lemma eq_S_l_lt_dec : {u = S l} + {S l < u}.
+Proof using ltc_l_u.
+ destruct (Nat.eq_dec u (S l)) as [Hd | Hd].
+ left. apply Hd. right. apply lt_S_l_u, Hd.
+Qed.
+
+Global Instance lt_0_u : 0 <c u.
+Proof using ltc_l_u. apply lt_s_u, Nat.le_0_l. Qed.
+
+Lemma neq_u_0 : u ≠0.
+Proof using ltc_l_u. apply neq_u_l. Qed.
+
+Lemma le_0_pred_u : 0 <= Nat.pred u.
+Proof using ltc_l_u. apply le_l_pred_u. Qed.
+
+Lemma lt_l_g : ∀ g : nat, u <= g -> l < g.
+Proof using ltc_l_u.
+ intros * H. eapply Nat.lt_le_trans. exact lt_l_u. exact H.
+Qed.
+
+Lemma lt_sub_u : ∀ s : nat, 0 < s -> u - s < u.
+Proof using ltc_l_u. intros * H. apply lt_sub, H. apply lt_0_u. Qed.
+
+End ltc_s_u.
+
+Section lt_pred_mul_ul_ur.
+
+Context {ll lr ul ur : nat} {ltc_ll_ul : ll <c ul} {ltc_lr_ur : lr <c ur}.
+
+Lemma lt_pred_mul_ul_ur : Nat.pred ((S ll) * (S lr)) < ul * ur.
+Proof using ltc_ll_ul ltc_lr_ur.
+ apply lt_pred_mul. all: apply lt_l_u.
+Qed.
+
+Lemma lt_ll_mul_ul_ur : ll < ul * ur.
+Proof using ltc_ll_ul ltc_lr_ur.
+ rewrite Nat.mul_comm. apply mul_lt_compat. apply lt_0_u. apply lt_l_u.
+Qed.
+
+Lemma lt_lr_mul_ul_ur : lr < ul * ur.
+Proof using ltc_ll_ul ltc_lr_ur.
+ apply mul_lt_compat. apply lt_0_u. apply lt_l_u.
+Qed.
+
+End lt_pred_mul_ul_ur.
+
+Section lt_pred_mul_ul_ur.
+
+Context {ll lr ul ur : nat} {ltc_ll_ul : ll <c ul} {ltc_lr_ur : lr <c ur}.
+
+Lemma lt_pred_ul_mul_ul_ur : Nat.pred ul < ul * ur.
+Proof using ltc_ll_ul ltc_lr_ur.
+ eapply @lt_s_u. eapply @lt_pred_mul_ul_ur. apply lt_pred_u.
+ apply lt_0_u. rewrite Nat.mul_1_r. reflexivity.
+Qed.
+
+Lemma lt_pred_ur_mul_ul_ur : Nat.pred ur < ul * ur.
+Proof using ltc_ll_ul ltc_lr_ur.
+ eapply @lt_s_u. eapply @lt_pred_mul_ul_ur. apply lt_0_u.
+ apply lt_pred_u. rewrite Nat.mul_1_l. reflexivity.
+Qed.
+
+End lt_pred_mul_ul_ur.
diff --git a/Util/Preliminary.v b/Util/Preliminary.v
index bfa4c8ca888911e048b433dad98501241e429263..40b02a496a3b6ee83ee55586626b16ed2282b8e1 100644
--- a/Util/Preliminary.v
+++ b/Util/Preliminary.v
@@ -19,13 +19,10 @@
(**************************************************************************)
-Require Import Relations.
-Require Import Morphisms.
-Require Import SetoidClass.
-Require Pactole.Util.FMaps.FMapInterface. (* for prod_Setoid and prod_EqDec *)
+Require Import Utf8 Relations Morphisms SetoidClass.
+Require Logic.Decidable.
Set Implicit Arguments.
-
Ltac autoclass := eauto with typeclass_instances.
Ltac inv H := inversion H; subst; clear H.
Hint Extern 1 (equiv ?x ?x) => reflexivity : core.
@@ -87,18 +84,22 @@ Definition monotonic {A B : Type} (RA : relation A) (RB : relation B) (f : A ->
Definition full_relation {A : Type} := fun _ _ : A => True.
-Global Hint Extern 0 (full_relation _ _) => exact I : core.
+#[export] Hint Extern 0 (full_relation _ _) => exact I : core.
-Instance relation_equivalence_subrelation {A} :
+Global Instance relation_equivalence_subrelation {A} :
forall R R' : relation A, relation_equivalence R R' -> subrelation R R'.
Proof. intros R R' Heq x y Hxy. now apply Heq. Qed.
+Global Instance neq_Symmetric {A} : Symmetric (fun x y : A => x <> y).
+Proof. intros ? ? Hneq ?. apply Hneq. now symmetry. Qed.
+
Global Hint Extern 3 (relation_equivalence _ _) => symmetry : core.
(** Notations for composition and inverse *)
+
Class Composition T `{Setoid T} := {
compose : T -> T -> T;
- compose_compat :> Proper (equiv ==> equiv ==> equiv) compose }.
+ #[global]compose_compat :: Proper (equiv ==> equiv ==> equiv) compose }.
Infix "∘" := compose (left associativity, at level 40).
Arguments Composition T {_}.
@@ -106,6 +107,86 @@ Arguments Composition T {_}.
(Bijection, Similarity, Isometry, etc.) *)
Class Inverse T `{Setoid T} := {
inverse : T -> T;
- inverse_compat :> Proper (equiv ==> equiv) inverse }.
+ #[global]inverse_compat :: Proper (equiv ==> equiv) inverse }.
Notation "bij â»Â¹" := (inverse bij) (at level 39).
Arguments Inverse T {_}.
+
+(* pick_spec can be useful when you want to test whether some 'oT : option T' is
+ 'Some t' or 'None'. Destructing 'pick_spec P oT' gives you directly 'P t'
+ in the first case and '∀ t : T, ¬ (P t)' in the other one *)
+Variant pick_spec (T : Type) (P : T -> Prop) : option T -> Type :=
+ Pick : ∀ x : T, P x → pick_spec P (Some x)
+ | Nopick : (∀ x : T, ¬ (P x)) → pick_spec P None.
+Arguments pick_spec [T] _ _.
+Arguments Pick [T P x] _.
+Arguments Nopick [T P] _.
+
+Lemma injective_compat_iff :
+ ∀ {A B : Type} {eqA : relation A} {eqB : relation B} (f : A -> B)
+ {compat : Proper (eqA ==> eqB) f}, injective eqA eqB f
+ -> ∀ a1 a2 : A, eqB (f a1) (f a2) <-> eqA a1 a2.
+Proof using .
+ intros * Hcompat Hinj *. split. apply Hinj. apply Hcompat.
+Qed.
+
+Lemma injective_eq_iff : ∀ {A B : Type} (f : A -> B),
+ injective eq eq f -> ∀ a1 a2 : A, f a1 = f a2 <-> a1 = a2.
+Proof using . intros *. apply injective_compat_iff. autoclass. Qed.
+
+Lemma eq_sym_iff : ∀ (A : Type) (x y : A), x = y <-> y = x.
+Proof using . intros. split. all: apply eq_sym. Qed.
+
+Lemma decidable_not_and_iff :
+ ∀ P Q : Prop, Decidable.decidable P -> ¬ (P ∧ Q) <-> ¬ P ∨ ¬ Q.
+Proof using .
+ intros * Hd. split. apply Decidable.not_and, Hd. intros Ho Ha.
+ destruct Ho as [Ho | Ho]. all: apply Ho, Ha.
+Qed.
+
+Lemma decidable_not_not_iff : ∀ P : Prop, Decidable.decidable P -> ¬ ¬ P <-> P.
+Proof using .
+ intros * Hd. split. apply Decidable.not_not, Hd. intros H Hn. apply Hn, H.
+Qed.
+
+Lemma sumbool_iff_compat :
+ ∀ P Q R S: Prop, P <-> R -> Q <-> S -> {P} + {Q} -> {R} + {S}.
+Proof using .
+ intros * H1 H2 [Hd | Hd]. left. apply H1, Hd. right. apply H2, Hd.
+Qed.
+
+Lemma sumbool_not_iff_compat :
+ ∀ P Q : Prop, P <-> Q -> {P} + {¬ P} -> {Q} + {¬ Q}.
+Proof using .
+ intros * H Hd. eapply sumbool_iff_compat.
+ 2: apply not_iff_compat. 1,2: apply H. apply Hd.
+Qed.
+
+Lemma sumbool_and_compat :
+ ∀ P Q R S: Prop, {P} + {Q} -> {R} + {S} -> {P ∧ R} + {Q ∨ S}.
+Proof using .
+ intros * [H1 | H1] [H2 | H2]. left. split. apply H1. apply H2.
+ all: right. right. apply H2. all: left. all: apply H1.
+Qed.
+
+Lemma sumbool_decidable : ∀ P : Prop, {P} + {¬ P} -> Decidable.decidable P.
+Proof using . intros P [H | H]. left. apply H. right. apply H. Qed.
+
+Lemma pair_eqE :
+ ∀ {A B : Type} (p1 p2 : A * B), fst p1 = fst p2 ∧ snd p1 = snd p2 <-> p1 = p2.
+Proof using .
+ intros. rewrite (surjective_pairing p1), (surjective_pairing p2).
+ symmetry. apply pair_equal_spec.
+Qed.
+
+Lemma pair_dec : ∀ {A B : Type},
+ (∀ a1 a2 : A, {a1 = a2} + {a1 ≠a2}) -> (∀ b1 b2 : B, {b1 = b2} + {b1 ≠b2})
+ -> ∀ p1 p2 : A * B, {p1 = p2} + {p1 ≠p2}.
+Proof using .
+ intros * Ha Hb *. eapply sumbool_not_iff_compat. apply pair_eqE.
+ eapply sumbool_iff_compat. reflexivity. symmetry. apply decidable_not_and_iff.
+ 2: apply sumbool_and_compat. 2: apply Ha. 2: apply Hb.
+ apply sumbool_decidable, Ha.
+Qed.
+
+Lemma and_cancel : ∀ P : Prop, P -> P ∧ P.
+Proof using . intros * H. split. all: apply H. Qed.
diff --git a/Util/Ratio.v b/Util/Ratio.v
index 6926488394af4c3c635bb556c5b3eada5dd1d81f..496d3492c9ba76aab8379d5422cb7373733fd8f7 100644
--- a/Util/Ratio.v
+++ b/Util/Ratio.v
@@ -32,12 +32,15 @@ Require Import Pactole.Util.Coqlib.
(** A ratio (of some quantity), as a real number between [0] and [1]. *)
Definition ratio := {x : R | 0 <= x <= 1}%R.
-Instance ratio_Setoid : Setoid ratio := sig_Setoid _.
-Instance ratio_EqDec : EqDec ratio_Setoid := @sig_EqDec _ _ _ _.
+Global Instance ratio_Setoid : Setoid ratio := sig_Setoid _.
+Global Instance ratio_EqDec : EqDec ratio_Setoid := @sig_EqDec _ _ _ _.
Definition proj_ratio : ratio -> R := @proj1_sig _ _.
-Instance proj_ratio_compat : Proper (equiv ==> equiv) proj_ratio.
+Lemma proj_ratio_inj : injective equiv equiv proj_ratio.
+Proof using . apply proj1_sig_inj. Qed.
+
+Global Instance proj_ratio_compat : Proper (equiv ==> eq) proj_ratio.
Proof. intros ? ? Heq. apply Heq. Qed.
Coercion proj_ratio : ratio >-> R.
@@ -75,22 +78,25 @@ abstract (split; solve [ apply Rplus_le_le_0_compat; apply ratio_bounds
| now apply Rlt_le, Rnot_le_lt ]).
Defined.
-Instance add_ratio_compat : Proper (equiv ==> equiv ==> equiv) add_ratio.
+Global Instance add_ratio_compat : Proper (equiv ==> equiv ==> equiv) add_ratio.
Proof. intros [] [] ? [] [] ?. unfold add_ratio. simpl in *. subst. destruct_match; reflexivity. Qed.
(** A strict ratio is a [ratio] that is neither [0] nor [1]. *)
Definition strict_ratio := {x : R | 0 < x < 1}%R.
-Instance strict_ratio_Setoid : Setoid ratio := sig_Setoid _.
-Instance strict_ratio_EqDec : EqDec strict_ratio_Setoid := @sig_EqDec _ _ _ _.
+Global Instance strict_ratio_Setoid : Setoid strict_ratio := sig_Setoid _.
+Global Instance strict_ratio_EqDec : EqDec strict_ratio_Setoid := @sig_EqDec _ _ _ _.
Definition proj_strict_ratio (x : strict_ratio) : ratio :=
let '(exist _ v Hv) := x in
exist _ v (conj (Rlt_le _ _ (proj1 Hv)) (Rlt_le _ _ (proj2 Hv))).
-Instance proj_strict_ratio_compat : Proper (equiv ==> equiv) proj_strict_ratio.
+Global Instance proj_strict_ratio_compat : Proper (equiv ==> equiv) proj_strict_ratio.
Proof. intros [] [] Heq. apply Heq. Qed.
+Lemma proj_strict_ratio_inj : injective equiv equiv proj_strict_ratio.
+Proof using . intros [][] H. cbn in H. subst. reflexivity. Qed.
+
Coercion proj_strict_ratio : strict_ratio >-> ratio.
Lemma strict_ratio_bounds : forall r : strict_ratio, (0 < r < 1)%R.
@@ -112,6 +118,9 @@ Notation "n '/sr' m" := (mk_strict_ratio n m ltac:(clear; abstract lia) ltac:(cl
(only parsing, at level 10).
Notation "n '/sr' m" := (mk_strict_ratio n m _ _) (at level 10, only printing).
+Lemma proj_ratio_strict_ratio : forall x, proj_ratio (proj_strict_ratio x) = proj1_sig x.
+Proof. intros []. reflexivity. Qed.
+
(** ** Trajectory **)
(** Trajectories are paths inside the space. *)
@@ -122,15 +131,15 @@ Record path T `{Setoid T}:= {
path_compat :> Proper (equiv ==> equiv) path_f }.
Arguments path_f {T} {_} _ _.
-Instance path_Setoid T {S : Setoid T} : Setoid (path T).
-simple refine {| equiv := fun x y => path_f x == y |}; try apply fun_equiv; auto; [].
+Global Instance path_Setoid T {S : Setoid T} : Setoid (path T).
+simple refine {| equiv := fun x y => path_f x == y |}; try apply fun_Setoid; auto; [].
Proof. split.
+ intro. reflexivity.
+ intros ? ? ?. now symmetry.
+ intros ? ? ? ? ?. etransitivity; eauto.
Defined.
-Instance path_full_compat {T} `(Setoid T): Proper (equiv ==> equiv ==> equiv) path_f.
+Global Instance path_full_compat {T} `(Setoid T): Proper (equiv ==> equiv ==> equiv) path_f.
Proof.
intros p p' Hp x y Hxy. transitivity (path_f p y).
- now apply path_compat.
@@ -145,7 +154,7 @@ refine (Build_path _ _ (fun x => f (p x)) _).
Proof. intros x y Hxy. now apply Hf, path_compat. Defined.
Arguments lift_path T U _ _ f _ p /.
-Instance lift_path_compat {T U} {HT : Setoid T} {HU : Setoid U} :
+Global Instance lift_path_compat {T U} {HT : Setoid T} {HU : Setoid U} :
forall f (Hf : Proper (equiv ==> equiv) f), Proper (equiv ==> equiv) (@lift_path T U HT HU f Hf).
Proof. repeat intro. simpl. auto. Qed.
diff --git a/Util/SetoidDefs.v b/Util/SetoidDefs.v
index 10eba597b8d5c732a1986e3b8c43f381ee9c4a39..00f85237bba26440716690c679bc772c18a92c6f 100644
--- a/Util/SetoidDefs.v
+++ b/Util/SetoidDefs.v
@@ -19,9 +19,7 @@
(**************************************************************************)
-Require Import Rbase.
-Require Import RelationPairs.
-Require Import SetoidDec.
+Require Import Utf8 Rbase RelationPairs SetoidDec.
Require Import Pactole.Util.Preliminary.
Set Implicit Arguments.
@@ -29,34 +27,35 @@ Set Implicit Arguments.
(* To avoid infinite loops, we use a breadth-first search... *)
Typeclasses eauto := (bfs) 20.
(* but we need to remove [eq_setoid] as it matches everything... *)
-Global Remove Hints eq_setoid : Setoid.
+#[export] Remove Hints eq_setoid : Setoid.
(* while still declaring it for the types for which we still want to use it. *)
-Instance R_Setoid : Setoid R := eq_setoid R.
-Instance Z_Setoid : Setoid Z := eq_setoid Z.
-Instance nat_Setoid : Setoid nat := eq_setoid nat.
-Instance bool_Setoid : Setoid bool := eq_setoid bool.
-Instance unit_Setoid : Setoid unit := eq_setoid unit.
-
-Instance R_EqDec : EqDec R_Setoid := Req_EM_T.
-Instance Z_EqDec : EqDec Z_Setoid := Z.eq_dec.
-Instance nat_EqDec : EqDec nat_Setoid := Nat.eq_dec.
-Instance bool_EqDec : EqDec bool_Setoid := Bool.bool_dec.
-Instance unit_EqDec : EqDec unit_Setoid := fun x y => match x, y with tt, tt => left eq_refl end.
+#[export]Instance R_Setoid : Setoid R := eq_setoid R.
+#[export]Instance Z_Setoid : Setoid Z := eq_setoid Z.
+#[export]Instance nat_Setoid : Setoid nat := eq_setoid nat.
+#[export]Instance bool_Setoid : Setoid bool := eq_setoid bool.
+#[export]Instance unit_Setoid : Setoid unit := eq_setoid unit.
+
+#[export]Instance R_EqDec : EqDec R_Setoid := Req_dec_T.
+#[export]Instance Z_EqDec : EqDec Z_Setoid := Z.eq_dec.
+#[export]Instance nat_EqDec : EqDec nat_Setoid := Nat.eq_dec.
+#[export]Instance bool_EqDec : EqDec bool_Setoid := Bool.bool_dec.
+#[export]Instance unit_EqDec : EqDec unit_Setoid := fun x y => match x, y with tt, tt => left eq_refl end.
Notation "x == y" := (equiv x y).
+Notation "x == y :> A" := (@equiv A _ x y) (at level 70, y at next level, no associativity, only parsing).
Arguments complement A R x y /.
-Arguments Proper {A}%type R%signature m.
+Arguments Proper {A}%_type R%_signature m.
Lemma equiv_dec_refl {T U} {S : Setoid T} {E : EqDec S} :
forall (e : T) (A B : U), (if equiv_dec e e then A else B) = A.
-Proof using . intros. destruct_match; intuition. Qed.
+Proof using . intros. destruct_match; intuition auto with *. Qed.
Definition equiv_decb_refl [T] [S : Setoid T] (E : EqDec S) : forall x : T, x ==b x = true :=
fun x => equiv_dec_refl x true false.
(** ** Setoid Definitions **)
-Instance fun_equiv A B `(Setoid B) : Setoid (A -> B) | 4.
+Instance fun_Setoid A B `(Setoid B) : Setoid (A -> B) | 4.
Proof. exists (fun f g : A -> B => forall x, f x == g x).
split.
+ repeat intro. reflexivity.
@@ -64,10 +63,23 @@ split.
+ repeat intro. etransitivity; eauto.
Defined.
-Instance fun_equiv_pointwise_compat A B `{Setoid B} :
- subrelation (@equiv _ (fun_equiv A _)) (pointwise_relation _ equiv).
+#[export]Instance fun_Setoid_respectful_compat (A B : Type) (SB : Setoid B) :
+ subrelation (@equiv (A->B) (fun_Setoid A SB))
+ (respectful (@eq A) (@equiv B SB)).
+Proof using . intros ?? H ???. subst. apply H. Qed.
+
+#[export]Instance fun_Setoid_pointwise_compat A B `{Setoid B} :
+ subrelation (@equiv _ (fun_Setoid A _)) (pointwise_relation _ equiv).
Proof using . intros f g Hfg x. apply Hfg. Qed.
+#[export]Instance eq_Setoid_eq_compat (T : Type) :
+ subrelation (@equiv T (eq_setoid T)) (@eq T).
+Proof using . apply subrelation_refl. Qed.
+
+#[export]Instance eq_eq_Setoid_compat (T : Type) :
+ subrelation (@eq T) (@equiv T (eq_setoid T)).
+Proof using . apply subrelation_refl. Qed.
+
Notation "x =?= y" := (equiv_dec x y) (at level 70, no associativity).
(** Lifting an equivalence relation to an option type. *)
@@ -78,52 +90,128 @@ Definition opt_eq {T} (eqT : T -> T -> Prop) (xo yo : option T) :=
| Some x, Some y => eqT x y
end.
-Instance opt_eq_refl : forall T (R : T -> T -> Prop), Reflexive R -> Reflexive (opt_eq R).
+#[export]Instance opt_eq_refl : ∀ T (R : T -> T -> Prop), Reflexive R -> Reflexive (opt_eq R).
Proof using . intros T R HR [x |]; simpl; auto. Qed.
-Instance opt_eq_sym : forall T (R : T -> T -> Prop), Symmetric R -> Symmetric (opt_eq R).
+#[export]Instance opt_eq_sym : ∀ T (R : T -> T -> Prop), Symmetric R -> Symmetric (opt_eq R).
Proof using . intros T R HR [x |] [y |]; simpl; auto. Qed.
-Instance opt_eq_trans : forall T (R : T -> T -> Prop), Transitive R -> Transitive (opt_eq R).
+#[export]Instance opt_eq_trans : ∀ T (R : T -> T -> Prop), Transitive R -> Transitive (opt_eq R).
Proof using . intros T R HR [x |] [y |] [z |]; simpl; intros; eauto; contradiction. Qed.
-Instance opt_equiv T eqT (HeqT : @Equivalence T eqT) : Equivalence (opt_eq eqT).
+#[export]Instance opt_equiv T eqT (HeqT : @Equivalence T eqT) : Equivalence (opt_eq eqT).
Proof using . split; auto with typeclass_instances. Qed.
-Instance opt_Setoid T (S : Setoid T) : Setoid (option T) := {| equiv := opt_eq equiv |}.
+#[export]Instance opt_Setoid T (S : Setoid T) : Setoid (option T) := {| equiv := opt_eq equiv |}.
-Instance Some_compat `(Setoid) : Proper (equiv ==> @equiv _ (opt_Setoid _)) Some.
+#[export]Instance Some_compat `(Setoid) : Proper (equiv ==> @equiv _ (opt_Setoid _)) Some.
Proof using . intros ? ? Heq. apply Heq. Qed.
-Existing Instance Pactole.Util.FMaps.FMapInterface.prod_Setoid.
-(* Instance prod_Setoid : forall A B, Setoid A -> Setoid B -> Setoid (A * B) := *)
- (* Pactole.Util.FMaps.FMapInterface.prod_Setoid. *)
-Global Arguments Pactole.Util.FMaps.FMapInterface.prod_Setoid [A] [B] _ _.
-Global Notation prod_Setoid := Pactole.Util.FMaps.FMapInterface.prod_Setoid.
+Lemma Some_inj {T : Type} {ST : Setoid T} :
+ injective (@equiv _ ST) (@equiv _ (opt_Setoid ST)) Some.
+Proof using . intros t1 t2 H. exact H. Qed.
+
+Lemma Some_eq_inj {T : Type} : @injective T _ eq eq Some.
+Proof using . intros t1 t2 H1. inversion_clear H1. reflexivity. Qed.
+
+Lemma not_None {T : Type} {ST : Setoid T} :
+ ∀ ot : option T, ¬ (@equiv _ (opt_Setoid ST) ot None)
+ -> {t : T | @equiv _ (opt_Setoid ST) ot (Some t)}.
+Proof using .
+ intros * H. destruct ot as [t|]. constructor 1 with t.
+ reflexivity. contradict H. reflexivity.
+Qed.
+
+Lemma not_Some {T : Type} {ST : Setoid T} : ∀ ot : option T,
+ (∀ t : T, ¬ (@equiv _ (opt_Setoid ST) ot (Some t)))
+ -> @equiv _ (opt_Setoid ST) ot None.
+Proof using .
+ intros * H. destruct ot as [t|]. exfalso. apply (H t). all: reflexivity.
+Qed.
+
+Lemma not_None_iff {T : Type} {ST : Setoid T} :
+ ∀ ot : option T, ¬ (@equiv _ (opt_Setoid ST) ot None)
+ <-> ∃ t : T, @equiv _ (opt_Setoid ST) ot (Some t).
+Proof using .
+ intros. etransitivity. 2: split. 2: apply inhabited_sig_to_exists.
+ 2: apply exists_to_inhabited_sig. split.
+ - intros H. constructor. apply not_None, H.
+ - intros [[t H]] Hn. rewrite H in Hn. inversion Hn.
+Qed.
-Existing Instance Pactole.Util.FMaps.FMapInterface.prod_EqDec.
-(*Instance prod_EqDec A B `(EqDec A) `(EqDec B) : EqDec (@prod_Setoid A B _ _) :=
- Pactole.Util.FMaps.FMapInterface.prod_EqDec _ _.*)
-Global Arguments Pactole.Util.FMaps.FMapInterface.prod_EqDec [A] [B] {_} _ {_} _ _ _.
-Global Notation prod_EqDec:= Pactole.Util.FMaps.FMapInterface.prod_EqDec.
+Lemma option_decidable {T : Type} {ST : Setoid T} : ∀ ot : option T,
+ Decidable.decidable (@equiv _ (opt_Setoid ST) ot None).
+Proof using .
+ intros. destruct ot as [t|]. right. intros H. inversion H. left. reflexivity.
+Qed.
+
+Lemma pick_Some_None :
+ ∀ {T : Type} {ST : Setoid T} (P : T -> Prop) (oT : option T),
+ (∀ t : T, @equiv _ (opt_Setoid ST) oT (Some t) <-> P t)
+ -> (@equiv _ (opt_Setoid ST) oT None <-> (∀ t : T, ¬ (P t)))
+ -> pick_spec P oT.
+Proof using .
+ intros T ST * Hs Hn. destruct oT as [t|]. apply Pick, Hs.
+ 2: apply Nopick, Hn. all: reflexivity.
+Qed.
+
+Lemma opt_Setoid_eq : ∀ {T : Type} {ST : Setoid T} (o1 o2 : option T),
+ (∀ t1 t2 : T, @equiv _ ST t1 t2 <-> t1 = t2)
+ -> @equiv _ (opt_Setoid ST) o1 o2 <-> o1 = o2.
+Proof using .
+ intros * H1. destruct o1 as [t1|], o2 as [t2|].
+ 4: split; intros; reflexivity. 2,3: split; intros H2; inversion H2.
+ rewrite (injective_compat_iff Some_inj), (injective_compat_iff Some_eq_inj).
+ apply H1.
+Qed.
+
+(* This Setoid could be written using RelProd in which case,
+ revealing the "and" inside would be more troublesome than
+ with this simple definition. *)
+#[export]Instance prod_Setoid A B (SA : Setoid A) (SB : Setoid B) : Setoid (A * B).
+simple refine {| equiv := fun xn yp => fst xn == fst yp /\ snd xn == snd yp |}; auto; [].
+Proof. split.
++ repeat intro; now split.
++ repeat intro; split; now symmetry.
++ intros ? ? ? [? ?] [? ?]; split; etransitivity; eauto.
+Defined.
+
+#[export]Instance prod_EqDec A B (SA : Setoid A) (SB : Setoid B) (EDA : EqDec SA) (EDB : EqDec SB)
+ : EqDec (prod_Setoid SA SB).
+refine (fun xn yp => if equiv_dec (fst xn) (fst yp) then
+ if equiv_dec (snd xn) (snd yp) then left _ else right _
+ else right _).
+Proof.
+- now split.
+- abstract (intros [? ?]; contradiction).
+- abstract (intros [? ?]; contradiction).
+Defined.
(* Local Instance fst_relprod_compat {A B} : forall R S, Proper (R * S ==> R) (@fst A B) := fst_compat. *)
(* Local Instance snd_relprod_compat {A B} : forall R S, Proper (R * S ==> S) (@snd A B) := snd_compat. *)
-Local Instance fst_compat_pactole {A B : Type} {SA : Setoid A} {SB : Setoid B} :
+#[export] Instance fst_compat_pactole {A B : Type} {SA : Setoid A} {SB : Setoid B} :
Proper (@equiv _ (prod_Setoid SA SB) ==> equiv) fst.
Proof. now intros [] [] []. Qed.
-Local Instance snd_compat_pactole {A B : Type} {SA : Setoid A} {SB : Setoid B} :
+#[export] Instance snd_compat_pactole {A B : Type} {SA : Setoid A} {SB : Setoid B} :
Proper (@equiv _ (prod_Setoid SA SB) ==> equiv) snd.
Proof. now intros [] [] []. Qed.
-Local Instance pair_compat_pactole {A B : Type} {SA : Setoid A} {SB : Setoid B} :
+#[export] Instance pair_compat_pactole {A B : Type} {SA : Setoid A} {SB : Setoid B} :
Proper (equiv ==> equiv ==> @equiv _ (prod_Setoid SA SB)) pair.
Proof. repeat intro. now split. Qed.
+Lemma prod_Setoid_eq : ∀ {A B : Type} {SA : Setoid A} {SB : Setoid B}
+ (p1 p2 : A * B), (∀ a1 a2 : A, @equiv _ SA a1 a2 <-> a1 = a2)
+ -> (∀ b1 b2 : B, @equiv _ SB b1 b2 <-> b1 = b2)
+ -> @equiv _ (prod_Setoid SA SB) p1 p2 <-> p1 = p2.
+Proof using .
+ intros * Ha Hb. rewrite <- pair_eqE, <- Ha, <- Hb. reflexivity.
+Qed.
+
(* Setoid over [sig] types *)
-Instance sig_Setoid {T} (S : Setoid T) {P : T -> Prop} : Setoid (sig P).
+#[export]Instance sig_Setoid {T} (S : Setoid T) {P : T -> Prop} : Setoid (sig P).
simple refine {| equiv := fun x y => proj1_sig x == proj1_sig y |}; auto; [].
Proof. split.
+ intro. reflexivity.
@@ -131,10 +219,18 @@ Proof. split.
+ intros ? ? ? ? ?. etransitivity; eauto.
Defined.
-Instance sig_EqDec {T} {S : Setoid T} (E : EqDec S) (P : T -> Prop) : EqDec (@sig_Setoid T S P).
+#[export]Instance sig_EqDec {T} {S : Setoid T} (E : EqDec S) (P : T -> Prop) : EqDec (@sig_Setoid T S P).
Proof. intros ? ?. simpl. apply equiv_dec. Defined.
-Instance sigT_Setoid {T} (S : Setoid T) {P : T -> Type} : Setoid (sigT P).
+#[export]Instance proj1_sig_compat {T} {S : Setoid T} (E : EqDec S) (P : T -> Prop) :
+ Proper (@equiv _ (sig_Setoid S) ==> equiv) (@proj1_sig T P).
+Proof using . intros ?? H. apply H. Qed.
+
+Lemma proj1_sig_inj : ∀ {T : Type} {S : Setoid T} (P : T -> Prop),
+ injective (@equiv (sig P) (sig_Setoid S)) (@equiv T S) (@proj1_sig T P).
+Proof using . intros * ?? H. cbn. apply H. Qed.
+
+#[export]Instance sigT_Setoid {T} (S : Setoid T) {P : T -> Type} : Setoid (sigT P).
simple refine {| equiv := fun x y => projT1 x == projT1 y |}; auto; [].
Proof. split.
+ intro. reflexivity.
@@ -142,9 +238,13 @@ Proof. split.
+ intros ? ? ? ? ?. etransitivity; eauto.
Defined.
-Instance sigT_EqDec {T} {S : Setoid T} (E : EqDec S) (P : T -> Type) : EqDec (@sigT_Setoid T S P).
+#[export]Instance sigT_EqDec {T} {S : Setoid T} (E : EqDec S) (P : T -> Type) : EqDec (@sigT_Setoid T S P).
Proof. intros ? ?. simpl. apply equiv_dec. Defined.
+#[export]Instance projT1_compat {T} {S : Setoid T} (E : EqDec S) (P : T -> Type) :
+ Proper (@equiv _ (sigT_Setoid S) ==> equiv) (@projT1 T P).
+Proof using . intros ?? H. apply H. Qed.
+
(** The intersection of equivalence relations is still an equivalence relation. *)
Lemma inter_equivalence T R1 R2 (E1 : Equivalence R1) (E2 : Equivalence R2)
: Equivalence (fun x y : T => R1 x y /\ R2 x y).
@@ -161,7 +261,7 @@ Definition inter_Setoid {T} (S1 : Setoid T) (S2 : Setoid T) : Setoid T := {|
Definition inter_EqDec {T} {S1 S2 : Setoid T} (E1 : EqDec S1) (E2 : EqDec S2)
: EqDec (inter_Setoid S1 S2).
-Proof.
+Proof using .
intros x y. destruct (E1 x y), (E2 x y); (now left; split) || (right; intros []; contradiction).
Defined.
diff --git a/_CoqProject b/_CoqProject
index 883c93a7160ca697340f5f5dd3b4c09ff6cb1d2c..5a8175545707fa670391b671187e977c2bf090bb 100644
--- a/_CoqProject
+++ b/_CoqProject
@@ -40,6 +40,8 @@ Util/NumberComplements.v
Util/ListComplements.v
Util/Coqlib.v
Util/Bijection.v
+Util/Fin.v
+Util/Enum.v
Util/Stream.v
Util/Lexprod.v
Util/Ratio.v
@@ -61,6 +63,7 @@ Models/RigidFlexibleEquivalence.v
Models/RigidFlexibleEquivalence_Assumptions.v
Models/GraphEquivalence.v
Models/GraphEquivalence_Assumptions.v
+Models/RingSSync.v
## Spaces
Spaces/RealVectorSpace.v
@@ -73,6 +76,7 @@ Spaces/R.v
Spaces/R2.v
Spaces/Graph.v
Spaces/Isomorphism.v
+Spaces/ThresholdIsomorphism.v
Spaces/Ring.v
Spaces/Grid.v
@@ -115,7 +119,7 @@ CaseStudies/Gathering/InR2/Algorithm_withLight_Assumptions.v
## Case Study: Ring Exploration
-CaseStudies/Exploration/Definitions.v
+CaseStudies/Exploration/ExplorationDefs.v
CaseStudies/Exploration/ImpossibilityKDividesN.v
CaseStudies/Exploration/ImpossibilityKDividesN_Assumptions.v
CaseStudies/Exploration/Tower.v
diff --git a/minipactole/minipactole.v b/minipactole/minipactole.v
index 2b2efd7ee3c6adaafd356b8a22e280926abb2040..aef316fbf954d6fa0d6932982b2b807184e030fd 100644
--- a/minipactole/minipactole.v
+++ b/minipactole/minipactole.v
@@ -21,8 +21,8 @@ Class State {I:Type} {L:Type} {info:@State_info I} {position:@State_pos L}
info: I
}.
(* Point technique: le dernier argument de pos et info n'est pas implicite. *)
-Arguments pos {I}%type {L}%type {info} {position} State.
-Arguments info {I}%type {L}%type {info} {position} State.
+Arguments pos {I}%_type {L}%_type {info} {position} State.
+Arguments info {I}%_type {L}%_type {info} {position} State.
Module Minipactole. (* comme si c'était dans un autre fichier. *)
@@ -44,7 +44,7 @@ Module Minipactole. (* comme si c'était dans un autre fichier. *)
donc une autre égalité: "equiv". Deux configurations sont
"equiv" si elles ont le même comportement. Ceci devrait
permettre d'utiliser "rewrite" de façon plus agréable. *)
- Local Instance configuration_Setoid : Setoid configuration := fun_equiv ident _.
+ Local Instance configuration_Setoid : Setoid configuration := fun_Setoid ident _.
(* Le robogram est le programme qui tourne localement sur le
robot: il prend la configuration (observation parfaite de la
@@ -121,8 +121,8 @@ Section Vig2Cols.
intros.
case x;case y.
intros r r0 r1 r2.
- case (Rdec r1 r);intros;subst.
- - case (Rdec r2 r0);intros;subst.
+ case (Req_dec_T r1 r);intros; subst.
+ - case (Req_dec_T r2 r0);intros;cbn [equiv] in *;subst.
+ left; reflexivity.
+ right.
intro abs.