-
Notifications
You must be signed in to change notification settings - Fork 0
/
PQ.v
1776 lines (1624 loc) · 52.4 KB
/
PQ.v
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(* Implementation of positive (non zero) rationals using only nat *)
Require Import Utf8 Arith Morphisms Psatz.
Require Import Misc.
Set Nested Proofs Allowed.
Tactic Notation "flia" hyp_list(Hs) := clear - Hs; lia.
Reserved Notation "a // b" (at level 32).
Declare Scope PQ_scope.
Delimit Scope PQ_scope with PQ.
(* A PQ number {PQnum1:=a; PQden1:=b} represents the rational (a+1)/(b+1) *)
Record PQ := PQmake { PQnum1 : nat; PQden1 : nat }.
Arguments PQmake _%nat _%nat.
Arguments PQnum1 x%PQ : rename.
Arguments PQden1 x%PQ : rename.
Definition PQ_of_pair n d := PQmake (n - 1) (d - 1).
Definition nd x y := (PQnum1 x + 1) * (PQden1 y + 1).
Definition PQeq x y := nd x y = nd y x.
Theorem PQeq_dec : ∀ x y : PQ, {PQeq x y} + {¬ PQeq x y}.
Proof. intros; apply Nat.eq_dec. Qed.
Arguments PQeq_dec x%PQ y%PQ.
Definition if_PQeq {A} (P Q : A) x y := if PQeq_dec x y then P else Q.
Arguments if_PQeq _ _ _ x%PQ y%PQ.
Definition PQlt x y := nd x y < nd y x.
Definition PQle x y := nd x y ≤ nd y x.
Definition PQgt x y := PQlt y x.
Definition PQge x y := PQle y x.
(* addition, subtraction *)
Definition PQadd_num1 x y := nd x y + nd y x - 1.
Definition PQsub_num1 x y := nd x y - nd y x - 1.
Definition PQadd_den1 x y := (PQden1 x + 1) * (PQden1 y + 1) - 1.
Definition PQadd x y := PQmake (PQadd_num1 x y) (PQadd_den1 x y).
Definition PQsub x y := PQmake (PQsub_num1 x y) (PQadd_den1 x y).
Arguments PQadd x%PQ y%PQ.
Arguments PQsub x%PQ y%PQ.
(* multiplication, inversion, division *)
Definition PQmul_num1 x y := (PQnum1 x + 1) * (PQnum1 y + 1) - 1.
Definition PQmul_den1 x y := (PQden1 x + 1) * (PQden1 y + 1) - 1.
Definition PQmul x y := PQmake (PQmul_num1 x y) (PQmul_den1 x y).
Arguments PQmul x%PQ y%PQ.
Definition PQinv x := PQmake (PQden1 x) (PQnum1 x).
Module PQ_Notations.
(*
Notation "1" := (PQmake 0 0) : PQ_scope.
Notation "2" := (PQmake 1 0) : PQ_scope.
*)
Notation "a // b" := (PQ_of_pair a b) : PQ_scope.
Notation "x == y" := (PQeq x y) (at level 70) : PQ_scope.
Notation "x ≠≠ y" := (¬ PQeq x y) (at level 70) : PQ_scope.
Notation "'if_PQeq_dec' x y 'then' P 'else' Q" :=
(if_PQeq P Q x y) (at level 200, x at level 9, y at level 9).
Notation "x < y" := (PQlt x y) : PQ_scope.
Notation "x ≤ y" := (PQle x y) : PQ_scope.
Notation "x > y" := (PQgt x y) : PQ_scope.
Notation "x ≥ y" := (PQge x y) : PQ_scope.
Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z)%PQ (at level 70, y at next level) :
PQ_scope.
Notation "x + y" := (PQadd x y) : PQ_scope.
Notation "x - y" := (PQsub x y) : PQ_scope.
Notation "x * y" := (PQmul x y) : PQ_scope.
Notation "/ x" := (PQinv x) : PQ_scope.
Definition PQ_of_decimal_uint (n : Decimal.uint) : option PQ :=
let a := Nat.of_uint n in
if Nat.eq_dec a 0 then None
else Some (PQ_of_pair a 1).
Definition PQ_of_decimal_int (n : Decimal.int) : option PQ :=
match n with
| Decimal.Pos ui => PQ_of_decimal_uint ui
| Decimal.Neg ui => None
end.
Definition PQ_to_decimal_uint (pq : PQ) : option Decimal.uint :=
match PQden1 pq with
| 0 => Some (Nat.to_uint (PQnum1 pq + 1))
| _ => None
end.
Definition PQ_to_decimal_int (pq : PQ) : option Decimal.int :=
option_map Decimal.Pos (PQ_to_decimal_uint pq).
Numeral Notation PQ PQ_of_decimal_int PQ_to_decimal_int : PQ_scope.
(*
Check 25%PQ.
Check (22 // 7)%PQ.
*)
(*
Check 0%PQ.
*)
End PQ_Notations.
Import PQ_Notations.
Definition PQone x := PQmake (PQden1 x) (PQden1 x).
Definition PQ_of_nat n := PQmake (n - 1) 0.
(* equality *)
Theorem PQeq_refl : ∀ x : PQ, (x == x)%PQ.
Proof. easy. Qed.
Theorem PQeq_symm : ∀ x y : PQ, (x == y)%PQ → (y == x)%PQ.
Proof. easy. Qed.
Theorem PQeq_trans : ∀ x y z : PQ, (x == y)%PQ → (y == z)%PQ → (x == z)%PQ.
Proof.
unfold "==".
intros * Hxy Hyz.
unfold nd in *.
apply (Nat.mul_cancel_l _ _ (PQnum1 y + 1)); [ flia | ].
rewrite Nat.mul_assoc, Nat.mul_shuffle0, Hyz.
rewrite Nat.mul_shuffle0, <- Nat.mul_assoc, Hxy.
rewrite Nat.mul_comm, Nat.mul_shuffle0.
symmetry; apply Nat.mul_assoc.
Qed.
Add Parametric Relation : _ PQeq
reflexivity proved by PQeq_refl
symmetry proved by PQeq_symm
transitivity proved by PQeq_trans
as PQeq_equiv_rel.
Theorem PQeq_if : ∀ A {P Q : A} x y,
(if PQeq_dec x y then P else Q) = if_PQeq P Q x y.
Proof. easy. Qed.
(* allows to use rewrite inside a if_PQeq_dec ...
through PQeq_if, e.g.
H : (x = y)%PQ
====================
... if_PQeq_dec x z then P else Q ...
> rewrite H.
====================
... if_PQeq_dec y z then P else Q ...
*)
Instance PQif_PQeq_morph {P Q : Prop} :
Proper (PQeq ==> PQeq ==> iff) (λ x y, if PQeq_dec x y then P else Q).
Proof.
intros x1 x2 Hx y1 y2 Hy.
move y1 before x2; move y2 before y1.
destruct (PQeq_dec x1 y1) as [H1| H1]; rewrite Hx, Hy in H1.
-now destruct (PQeq_dec x2 y2).
-now destruct (PQeq_dec x2 y2).
Qed.
(* inequality *)
Definition PQcompare x y := Nat.compare (nd x y) (nd y x).
Arguments PQcompare x%PQ y%PQ.
Theorem PQcompare_eq_iff : ∀ x y, PQcompare x y = Eq ↔ (x == y)%PQ.
Proof. intros; apply Nat.compare_eq_iff. Qed.
Theorem PQcompare_lt_iff : ∀ x y, PQcompare x y = Lt ↔ (x < y)%PQ.
Proof. intros; apply Nat.compare_lt_iff. Qed.
Theorem PQcompare_gt_iff : ∀ x y, PQcompare x y = Gt ↔ (x > y)%PQ.
Proof. intros; apply Nat.compare_gt_iff. Qed.
Theorem PQle_refl : ∀ x, (x ≤ x)%PQ.
Proof. now unfold "≤"%PQ. Qed.
Theorem PQnlt_ge : ∀ x y, ¬ (x < y)%PQ ↔ (y ≤ x)%PQ.
Proof.
intros.
split; intros H; [ now apply Nat.nlt_ge in H | ].
now apply Nat.nlt_ge.
Qed.
Theorem PQnle_gt : ∀ x y, ¬ (x ≤ y)%PQ ↔ (y < x)%PQ.
Proof.
intros.
split; intros H; [ now apply Nat.nle_gt in H | ].
now apply Nat.nle_gt.
Qed.
Theorem PQlt_le_dec : ∀ x y : PQ, {(x < y)%PQ} + {(y ≤ x)%PQ}.
Proof.
intros (xn, xd) (yn, yd).
unfold PQlt, PQle, nd; simpl.
destruct (lt_dec ((xn + 1) * (yd + 1)) ((yn + 1) * (xd + 1))) as [H1| H1].
-now left.
-now right; apply Nat.nlt_ge.
Qed.
Arguments PQlt_le_dec x%PQ y%PQ.
Theorem PQle_lt_dec : ∀ x y : PQ, {(x ≤ y)%PQ} + {(y < x)%PQ}.
Proof.
intros (xn, xd) (yn, yd).
unfold PQlt, PQle, nd; simpl.
destruct (le_dec ((xn + 1) * (yd + 1)) ((yn + 1) * (xd + 1))) as [H1| H1].
-now left.
-now right; apply Nat.nle_gt.
Qed.
Arguments PQle_lt_dec x%PQ y%PQ.
Ltac split_var x :=
let xn := fresh x in
let xd := fresh x in
let Hpn := fresh x in
let Hpd := fresh x in
remember (PQnum1 x + 1) as xn eqn:Hxn;
remember (PQden1 x + 1) as xd eqn:Hxd;
assert (Hpn : 0 < xn) by flia Hxn;
assert (Hpd : 0 < xd) by flia Hxd;
clear Hxn Hxd.
(* allows to use rewrite inside a less than
e.g.
H : x = y
====================
(x < z)%PQ
rewrite H.
*)
Instance PQlt_morph : Proper (PQeq ==> PQeq ==> iff) PQlt.
Proof.
assert (H : ∀ x1 x2 y1 y2,
(x1 == x2)%PQ → (y1 == y2)%PQ → (x1 < y1)%PQ → (x2 < y2)%PQ). {
intros x1q x2q y1q y2q Hx Hy Hxy.
unfold "<"%PQ, nd in Hxy |-*.
unfold "=="%PQ, nd in Hx, Hy.
split_var x1q; split_var x2q; split_var y1q; split_var y2q.
move Hx before Hy.
apply (Nat.mul_lt_mono_pos_l y1q0); [ easy | ].
rewrite Nat.mul_assoc, Nat.mul_shuffle0, Hy; clear Hy.
remember (y2q0 * y1q1 * x2q0) as u; rewrite Nat.mul_comm; subst u.
do 2 rewrite <- Nat.mul_assoc.
apply Nat.mul_lt_mono_pos_l; [ easy | ].
apply (Nat.mul_lt_mono_pos_r x1q1); [ easy | ].
rewrite <- Nat.mul_assoc, <- Hx; clear Hx.
rewrite Nat.mul_assoc, Nat.mul_comm.
rewrite <- Nat.mul_assoc.
apply Nat.mul_lt_mono_pos_l; [ easy | ].
now rewrite Nat.mul_comm.
}
intros x1 x2 Hx y1 y2 Hy.
move y1 before x2; move y2 before y1.
split; intros Hxy.
-now apply (H x1 x2 y1 y2).
-symmetry in Hx, Hy.
now apply (H x2 x1 y2 y1).
Qed.
Instance PQgt_morph : Proper (PQeq ==> PQeq ==> iff) PQgt.
Proof.
intros x1 x2 Hx y1 y2 Hy.
now apply PQlt_morph.
Qed.
(* allows to use rewrite inside a less equal
e.g.
H : x = y
====================
(x ≤ z)%PQ
rewrite H.
*)
Instance PQle_morph : Proper (PQeq ==> PQeq ==> iff) PQle.
Proof.
assert (H : ∀ x1 x2 y1 y2,
(x1 == x2)%PQ → (y1 == y2)%PQ → (x1 ≤ y1)%PQ → (x2 ≤ y2)%PQ). {
intros x1q x2q y1q y2q Hx Hy Hxy.
unfold "≤"%PQ, nd in Hxy |-*.
unfold "=="%PQ, nd in Hx, Hy.
split_var x1q; split_var x2q; split_var y1q; split_var y2q.
move Hx before Hy.
apply (Nat.mul_le_mono_pos_l _ _ y1q0); [ easy | ].
rewrite Nat.mul_assoc, Nat.mul_shuffle0, Hy; clear Hy.
remember (y2q0 * y1q1 * x2q0) as u; rewrite Nat.mul_comm; subst u.
do 2 rewrite <- Nat.mul_assoc.
apply Nat.mul_le_mono_pos_l; [ easy | ].
apply (Nat.mul_le_mono_pos_r _ _ x1q1); [ easy | ].
rewrite <- Nat.mul_assoc, <- Hx; clear Hx.
rewrite Nat.mul_assoc, Nat.mul_comm.
rewrite <- Nat.mul_assoc.
apply Nat.mul_le_mono_pos_l; [ easy | ].
now rewrite Nat.mul_comm.
}
intros x1 x2 Hx y1 y2 Hy.
move y1 before x2; move y2 before y1.
split; intros Hxy.
-now apply (H x1 x2 y1 y2).
-symmetry in Hx, Hy.
now apply (H x2 x1 y2 y1).
Qed.
Instance PQge_morph : Proper (PQeq ==> PQeq ==> iff) PQge.
Proof.
intros x1 x2 Hx y1 y2 Hy.
now apply PQle_morph.
Qed.
(* allows to use rewrite inside an addition
e.g.
H : x = y
====================
..... (x + z)%PQ ....
rewrite H.
*)
Instance PQadd_morph : Proper (PQeq ==> PQeq ==> PQeq) PQadd.
Proof.
intros x1q x2q Hx y1q y2q Hy.
move Hx before Hy.
unfold "+"%PQ.
unfold "==", nd in Hx, Hy |-*.
unfold PQadd_num1, PQadd_den1, nd; simpl.
rewrite Nat.sub_add; [ | do 4 rewrite Nat.add_1_r; simpl; flia ].
rewrite Nat.sub_add; [ | do 2 rewrite Nat.add_1_r; simpl; flia ].
rewrite Nat.sub_add; [ | do 2 rewrite Nat.add_1_r; simpl; flia ].
rewrite Nat.sub_add; [ | do 2 rewrite Nat.add_1_r; simpl; flia ].
split_var x1q; split_var x2q; split_var y1q; split_var y2q.
move Hx before Hy.
ring_simplify.
rewrite Nat.add_comm; f_equal.
-replace (y1q0 * x1q1 * x2q1 * y2q1) with (y1q0 * y2q1 * x1q1 * x2q1) by flia.
rewrite Hy; flia.
-replace (x1q0 * y1q1 * x2q1) with (x1q0 * x2q1 * y1q1) by flia.
rewrite Hx; flia.
Qed.
Theorem PQsub_morph : ∀ x1 x2 y1 y2,
(x1 < y1)%PQ
→ (x1 == x2)%PQ
→ (y1 == y2)%PQ
→ (y1 - x1 == y2 - x2)%PQ.
Proof.
intros * H1 Hx Hy.
generalize H1; intros H2; move H2 before H1.
rewrite Hx, Hy in H2.
unfold "-"%PQ.
unfold "==", nd in Hx, Hy |-*.
unfold "<"%PQ, nd in H1, H2.
unfold PQsub_num1, PQadd_den1, nd; simpl.
do 4 rewrite Nat.add_1_r in H1, H2, Hx, Hy.
do 12 rewrite Nat.add_1_r.
do 2 (rewrite <- Nat.sub_succ_l; [ | flia H1 ]).
rewrite Nat_sub_sub_swap, Nat.sub_succ, Nat.sub_0_r.
rewrite <- Nat.sub_succ_l; [ | simpl; flia ].
rewrite Nat.sub_succ, Nat.sub_0_r.
do 2 (rewrite <- Nat.sub_succ_l; [ | flia H2 ]).
rewrite Nat_sub_sub_swap, Nat.sub_succ, Nat.sub_0_r.
rewrite <- Nat.sub_succ_l; [ | simpl; flia ].
rewrite Nat.sub_succ, Nat.sub_0_r.
do 2 rewrite Nat.mul_sub_distr_r.
remember (S (PQnum1 x1)) as x1n eqn:Hx1n.
remember (S (PQden1 x1)) as x1d eqn:Hx1d.
remember (S (PQnum1 x2)) as x2n eqn:Hx2n.
remember (S (PQden1 x2)) as x2d eqn:Hx2d.
remember (S (PQnum1 y1)) as y1n eqn:Hy1n.
remember (S (PQden1 y1)) as y1d eqn:Hy1d.
remember (S (PQnum1 y2)) as y2n eqn:Hy2n.
remember (S (PQden1 y2)) as y2d eqn:Hy2d.
move H1 before H2.
f_equal.
-replace (y1n * x1d * (y2d * x2d)) with (y1n * y2d * x1d * x2d) by flia.
rewrite Hy; flia.
-replace (x1n * y1d * (y2d * x2d)) with (x1n * x2d * y1d * y2d) by flia.
rewrite Hx; flia.
Qed.
Arguments PQsub_morph x1%PQ x2%PQ y1%PQ y2%PQ.
(* allows to use rewrite inside a multiplication
e.g.
H : x = y
====================
..... (x * z)%PQ ....
rewrite H.
*)
Instance PQmul_morph : Proper (PQeq ==> PQeq ==> PQeq) PQmul.
Proof.
unfold "*"%PQ.
unfold "==", nd; simpl.
unfold PQmul_num1, PQmul_den1; simpl.
intros x1 x2 Hx y1 y2 Hy; simpl.
move Hx before Hy.
do 4 rewrite Nat.add_1_r in Hx, Hy.
do 12 rewrite Nat.add_1_r.
do 4 (rewrite <- Nat.sub_succ_l; [ | simpl; flia ]).
do 4 rewrite Nat.sub_succ, Nat.sub_0_r.
setoid_rewrite Nat.mul_shuffle0.
do 2 rewrite Nat.mul_assoc; rewrite Hx.
setoid_rewrite <- Nat.mul_assoc; f_equal.
rewrite Nat.mul_comm, Hy.
apply Nat.mul_comm.
Qed.
Ltac split_var2 x xn xd Hpn Hpd :=
remember (S (PQnum1 x)) as xn eqn:Heqxn;
remember (S (PQden1 x)) as xd eqn:Heqxd;
move xn at top; move xd at top;
assert (Hpn : 0 < xn) by flia Heqxn;
assert (Hpd : 0 < xd) by flia Heqxd;
clear Heqxn Heqxd.
Ltac PQtac1 :=
unfold "+"%PQ, "-"%PQ, "<"%PQ, "=="%PQ, "≤"%PQ;
unfold PQadd_num1, PQsub_num1, PQadd_den1, nd; simpl;
repeat rewrite Nat.add_1_r.
Ltac PQtac2 :=
rewrite <- Nat.sub_succ_l;
try (rewrite Nat.sub_succ, Nat.sub_0_r);
match goal with
| [ |- 1 ≤ S _ * _ ] => try (simpl; flia)
| [ |- 1 ≤ S _ * _ * _ ] => try (simpl; flia)
| _ => idtac
end.
Ltac PQtac3 :=
repeat rewrite Nat.mul_sub_distr_l;
repeat rewrite Nat.mul_add_distr_l;
repeat rewrite Nat.mul_sub_distr_r;
repeat rewrite Nat.mul_add_distr_r;
repeat rewrite Nat.mul_assoc.
Theorem PQmul_one_r : ∀ x y, (x * PQone y == x)%PQ.
Proof.
intros.
unfold "*"%PQ, "==", PQone, nd; simpl.
unfold PQmul_num1, PQmul_den1; simpl.
PQtac1; repeat PQtac2; PQtac3.
apply Nat.mul_shuffle0.
Qed.
Theorem PQle_antisymm_eq : ∀ x y,
(x ≤ y)%PQ → (y ≤ x)%PQ → (x * PQone y = y * PQone x)%PQ.
Proof.
intros x y Hxy Hyx.
unfold PQone, "*"%PQ; simpl.
unfold PQmul_num1, PQmul_den1; simpl.
specialize (Nat.le_antisymm _ _ Hxy Hyx) as H.
unfold nd in H; rewrite H.
f_equal.
now rewrite Nat.mul_comm.
Qed.
Theorem PQle_antisymm : ∀ x y, (x ≤ y)%PQ → (y ≤ x)%PQ → (x == y)%PQ.
Proof.
intros * Hxy Hyx.
apply (Nat.le_antisymm _ _ Hxy Hyx).
Qed.
Theorem PQadd_comm : ∀ x y, (x + y)%PQ = (y + x)%PQ.
Proof.
intros.
unfold "+"%PQ; f_equal.
-now unfold PQadd_num1, nd; rewrite Nat.add_comm.
-now unfold PQadd_den1, nd; rewrite Nat.mul_comm.
Qed.
Theorem PQadd_add_swap : ∀ x y z, (x + y + z)%PQ = (x + z + y)%PQ.
Proof.
intros; PQtac1.
repeat PQtac2; [ | simpl; flia | simpl; flia ].
PQtac3; f_equal; [ | f_equal; apply Nat.mul_shuffle0 ].
f_equal.
rewrite Nat.add_shuffle0.
f_equal; f_equal.
apply Nat.mul_shuffle0.
Qed.
Theorem PQadd_assoc : ∀ x y z, (x + (y + z))%PQ = ((x + y) + z)%PQ.
Proof.
intros.
rewrite PQadd_comm.
remember (x + y)%PQ as t eqn:Ht.
rewrite PQadd_comm in Ht; subst t.
apply PQadd_add_swap.
Qed.
(* *)
Theorem PQlt_irrefl : ∀ x, (¬ x < x)%PQ.
Proof. intros x; apply Nat.lt_irrefl. Qed.
Theorem PQlt_le_incl : ∀ x y, (x < y)%PQ → (x ≤ y)%PQ.
Proof. intros * Hxy; now apply Nat.lt_le_incl. Qed.
Theorem PQle_trans : ∀ x y z, (x ≤ y)%PQ → (y ≤ z)%PQ → (x ≤ z)%PQ.
Proof.
intros * Hxy Hyz.
unfold "≤"%PQ, nd in Hxy, Hyz |-*.
apply (Nat.mul_le_mono_pos_r _ _ (PQden1 y + 1)); [ flia | ].
rewrite Nat.mul_shuffle0.
apply (Nat.le_trans _ ((PQnum1 y + 1) * (PQden1 x + 1) * (PQden1 z + 1))).
-apply Nat.mul_le_mono_pos_r; [ flia | easy ].
-setoid_rewrite Nat.mul_shuffle0.
apply Nat.mul_le_mono_pos_r; [ flia | easy ].
Qed.
Arguments PQle_trans x%PQ y%PQ z%PQ.
Theorem PQlt_trans : ∀ x y z, (x < y)%PQ → (y < z)%PQ → (x < z)%PQ.
Proof.
intros * Hxy Hyz.
unfold "<"%PQ, nd in Hxy, Hyz |-*.
apply (Nat.mul_lt_mono_pos_r (PQden1 y + 1)); [ flia | ].
rewrite Nat.mul_shuffle0.
apply (Nat.lt_trans _ ((PQnum1 y + 1) * (PQden1 x + 1) * (PQden1 z + 1))).
-apply Nat.mul_lt_mono_pos_r; [ flia | easy ].
-setoid_rewrite Nat.mul_shuffle0.
apply Nat.mul_lt_mono_pos_r; [ flia | easy ].
Qed.
Arguments PQlt_trans x%PQ y%PQ z%PQ.
Theorem PQle_lt_trans : ∀ x y z, (x ≤ y)%PQ → (y < z)%PQ → (x < z)%PQ.
Proof.
intros * Hxy Hyz.
unfold "<"%PQ, nd in Hyz |-*.
unfold "≤"%PQ, nd in Hxy.
apply (Nat.mul_lt_mono_pos_r (PQden1 y + 1)); [ flia | ].
rewrite Nat.mul_shuffle0.
apply (Nat.le_lt_trans _ ((PQnum1 y + 1) * (PQden1 x + 1) * (PQden1 z + 1))).
-apply Nat.mul_le_mono_pos_r; [ flia | easy ].
-setoid_rewrite Nat.mul_shuffle0.
apply Nat.mul_lt_mono_pos_r; [ flia | easy ].
Qed.
Theorem PQlt_le_trans : ∀ x y z, (x < y)%PQ → (y ≤ z)%PQ → (x < z)%PQ.
Proof.
intros * Hxy Hyz.
unfold "<"%PQ, nd in Hxy |-*.
unfold "≤"%PQ, nd in Hyz.
apply (Nat.mul_lt_mono_pos_r (PQden1 y + 1)); [ flia | ].
rewrite Nat.mul_shuffle0.
apply (Nat.lt_le_trans _ ((PQnum1 y + 1) * (PQden1 x + 1) * (PQden1 z + 1))).
-apply Nat.mul_lt_mono_pos_r; [ flia | easy ].
-setoid_rewrite Nat.mul_shuffle0.
apply Nat.mul_le_mono_pos_r; [ flia | easy ].
Qed.
Instance PQcompare_morph : Proper (PQeq ==> PQeq ==> eq) PQcompare.
Proof.
intros x1 x2 Hx y1 y2 Hy.
move Hx before Hy.
remember (PQcompare x1 y1) as c1 eqn:Hc1; symmetry in Hc1.
remember (PQcompare x2 y2) as c2 eqn:Hc2; symmetry in Hc2.
move c2 before c1.
destruct c1.
-apply PQcompare_eq_iff in Hc1.
destruct c2; [ easy | | ].
+apply PQcompare_lt_iff in Hc2.
rewrite <- Hy, <- Hc1, Hx in Hc2.
now apply PQlt_irrefl in Hc2.
+apply PQcompare_gt_iff in Hc2.
rewrite <- Hy, <- Hc1, Hx in Hc2.
now apply PQlt_irrefl in Hc2.
-apply PQcompare_lt_iff in Hc1.
destruct c2; [ | easy | ].
+apply PQcompare_eq_iff in Hc2.
rewrite Hx, Hc2, Hy in Hc1.
now apply PQlt_irrefl in Hc1.
+apply PQcompare_gt_iff in Hc2.
rewrite Hx, Hy in Hc1.
apply PQnle_gt in Hc2.
now exfalso; apply Hc2, PQlt_le_incl.
-apply PQcompare_gt_iff in Hc1.
destruct c2; [ | | easy ].
+apply PQcompare_eq_iff in Hc2.
rewrite Hx, Hc2, <- Hy in Hc1.
now apply PQlt_irrefl in Hc1.
+apply PQcompare_lt_iff in Hc2.
rewrite Hx, Hy in Hc1.
apply PQnle_gt in Hc2.
now exfalso; apply Hc2, PQlt_le_incl.
Qed.
Arguments PQcompare_morph x1%PQ x2%PQ Hx%PQ y1%PQ y2%PQ Hy%PQ : rename.
Theorem PQadd_lt_mono_r : ∀ x y z, (x < y)%PQ ↔ (x + z < y + z)%PQ.
Proof.
unfold "<"%PQ, "+"%PQ, PQadd_num1, PQadd_den1, nd; simpl.
intros *.
do 10 rewrite Nat.add_1_r.
do 4 (rewrite <- Nat.sub_succ_l; [ | simpl; flia ]).
do 4 rewrite Nat.sub_succ, Nat.sub_0_r.
do 2 rewrite Nat.mul_add_distr_r.
remember (S (PQnum1 x)) as xn eqn:Hxn.
remember (S (PQden1 x)) as xd eqn:Hxd.
remember (S (PQnum1 y)) as yn eqn:Hyn.
remember (S (PQden1 y)) as yd eqn:Hyd.
remember (S (PQnum1 z)) as zn eqn:Hzn.
remember (S (PQden1 z)) as zd eqn:Hzd.
replace (zn * yd * (xd * zd)) with (zn * xd * (yd * zd)) by flia.
replace (xn * zd * (yd * zd)) with (xn * yd * (zd * zd)) by flia.
replace (yn * zd * (xd * zd)) with (yn * xd * (zd * zd)) by flia.
split; intros H.
-apply Nat.add_lt_mono_r.
apply Nat.mul_lt_mono_pos_r; [ | easy ].
subst zd; simpl; flia.
-apply Nat.add_lt_mono_r in H.
apply Nat.mul_lt_mono_pos_r in H; [ easy | ].
subst zd; simpl; flia.
Qed.
Theorem PQadd_lt_mono_l : ∀ x y z, (y < z)%PQ ↔ (x + y < x + z)%PQ.
Proof.
intros.
setoid_rewrite PQadd_comm.
apply PQadd_lt_mono_r.
Qed.
Theorem PQadd_le_mono_r : ∀ x y z, (x ≤ y ↔ x + z ≤ y + z)%PQ.
Proof.
unfold "≤"%PQ, "+"%PQ, PQadd_num1, PQadd_den1, nd; simpl.
intros *.
do 10 rewrite Nat.add_1_r.
do 4 (rewrite <- Nat.sub_succ_l; [ | simpl; flia ]).
do 4 rewrite Nat.sub_succ, Nat.sub_0_r.
do 2 rewrite Nat.mul_add_distr_r.
remember (S (PQnum1 x)) as xn eqn:Hxn.
remember (S (PQden1 x)) as xd eqn:Hxd.
remember (S (PQnum1 y)) as yn eqn:Hyn.
remember (S (PQden1 y)) as yd eqn:Hyd.
remember (S (PQnum1 z)) as zn eqn:Hzn.
remember (S (PQden1 z)) as zd eqn:Hzd.
replace (zn * yd * (xd * zd)) with (zn * xd * (yd * zd)) by flia.
replace (xn * zd * (yd * zd)) with (xn * yd * (zd * zd)) by flia.
replace (yn * zd * (xd * zd)) with (yn * xd * (zd * zd)) by flia.
split; intros H.
-apply Nat.add_le_mono_r.
now apply Nat.mul_le_mono_r.
-apply Nat.add_le_mono_r in H.
apply Nat.mul_le_mono_pos_r in H; [ easy | ].
subst zd; simpl; flia.
Qed.
Theorem PQadd_le_mono_l : ∀ x y z, (x ≤ y ↔ z + x ≤ z + y)%PQ.
Proof.
setoid_rewrite PQadd_comm.
apply PQadd_le_mono_r.
Qed.
Theorem PQadd_le_mono : ∀ x y z t,
(x ≤ y)%PQ → (z ≤ t)%PQ → (x + z ≤ y + t)%PQ.
Proof.
intros * Hxy Hzt.
apply (PQle_trans _ (y + z)%PQ).
-now apply PQadd_le_mono_r.
-now apply PQadd_le_mono_l.
Qed.
Theorem PQsub_add_eq : ∀ x y,
(y < x)%PQ → (x - y + y = x * PQone y * PQone y)%PQ.
Proof.
intros x y Hxy.
unfold "<"%PQ, nd in Hxy.
unfold "+"%PQ, "-"%PQ, "==", nd; simpl.
unfold PQsub_num1, PQadd_num1, PQadd_den1, nd; simpl.
unfold "*"%PQ, PQone, PQmul_num1, PQmul_den1; simpl.
do 4 rewrite Nat.add_1_r in Hxy.
f_equal.
PQtac1; repeat PQtac2; [ | flia Hxy ].
PQtac3; rewrite Nat.sub_add; [ easy | ].
setoid_rewrite Nat.mul_shuffle0.
rewrite Nat.mul_shuffle0.
now apply Nat.mul_le_mono_r, Nat.lt_le_incl.
Qed.
Theorem PQsub_add : ∀ x y, (y < x)%PQ → (x - y + y == x)%PQ.
Proof.
intros x y Hxy.
rewrite PQsub_add_eq; [ | easy ].
now do 2 rewrite PQmul_one_r.
Qed.
Theorem PQsub_le_mono_r : ∀ x y z,
(z < x)%PQ → (z < y)%PQ → (x ≤ y ↔ x - z ≤ y - z)%PQ.
Proof.
intros * Hzx Hzy.
split.
-intros Hxy.
revert Hzx Hxy Hzy.
unfold "≤"%PQ, "<"%PQ, "-"%PQ, PQsub_num1, PQadd_den1, nd; simpl.
do 10 rewrite Nat.add_1_r.
intros.
rewrite <- Nat.sub_succ_l; [ | flia Hzx ].
rewrite Nat.sub_succ, Nat.sub_0_r.
rewrite <- Nat.sub_succ_l; [ | simpl; flia ].
rewrite Nat.sub_succ, Nat.sub_0_r.
rewrite <- Nat.sub_succ_l; [ | flia Hzy ].
rewrite Nat.sub_succ, Nat.sub_0_r.
rewrite <- Nat.sub_succ_l; [ | simpl; flia ].
rewrite Nat.sub_succ, Nat.sub_0_r.
remember (S (PQnum1 x)) as xn eqn:Hxn.
remember (S (PQden1 x)) as xd eqn:Hxd.
remember (S (PQnum1 y)) as yn eqn:Hyn.
remember (S (PQden1 y)) as yd eqn:Hyd.
remember (S (PQnum1 z)) as zn eqn:Hzn.
remember (S (PQden1 z)) as zd eqn:Hzd.
do 2 rewrite Nat.mul_sub_distr_r.
replace (zn * yd * (xd * zd)) with (zn * xd * (yd * zd)) by flia.
replace (xn * zd * (yd * zd)) with (xn * yd * (zd * zd)) by flia.
replace (yn * zd * (xd * zd)) with (yn * xd * (zd * zd)) by flia.
apply Nat.sub_le_mono_r.
now apply Nat.mul_le_mono_r.
-intros Hxyz.
apply (PQadd_le_mono_r _ _ z) in Hxyz.
rewrite PQsub_add in Hxyz; [ | easy ].
now rewrite PQsub_add in Hxyz.
Qed.
Theorem PQsub_le_mono_l : ∀ x y z,
(x < z)%PQ → (y < z)%PQ → (y ≤ x)%PQ ↔ (z - x ≤ z - y)%PQ.
Proof.
intros * Hzx Hzy.
split.
-intros Hxy.
revert Hzx Hxy Hzy.
unfold "≤"%PQ, "<"%PQ, "-"%PQ, PQsub_num1, PQadd_den1, nd; simpl.
do 10 rewrite Nat.add_1_r.
intros.
rewrite <- Nat.sub_succ_l; [ | flia Hzx ].
rewrite Nat.sub_succ, Nat.sub_0_r.
rewrite <- Nat.sub_succ_l; [ | simpl; flia ].
rewrite Nat.sub_succ, Nat.sub_0_r.
rewrite <- Nat.sub_succ_l; [ | flia Hzy ].
rewrite Nat.sub_succ, Nat.sub_0_r.
rewrite <- Nat.sub_succ_l; [ | simpl; flia ].
rewrite Nat.sub_succ, Nat.sub_0_r.
remember (S (PQnum1 x)) as xn eqn:Hxn.
remember (S (PQden1 x)) as xd eqn:Hxd.
remember (S (PQnum1 y)) as yn eqn:Hyn.
remember (S (PQden1 y)) as yd eqn:Hyd.
remember (S (PQnum1 z)) as zn eqn:Hzn.
remember (S (PQden1 z)) as zd eqn:Hzd.
do 2 rewrite Nat.mul_sub_distr_r.
replace (zn * yd * (zd * xd)) with (zn * xd * (zd * yd)) by flia.
replace (xn * zd * (zd * yd)) with (xn * yd * (zd * zd)) by flia.
replace (yn * zd * (zd * xd)) with (yn * xd * (zd * zd)) by flia.
apply Nat.sub_le_mono_l.
now apply Nat.mul_le_mono_r.
-intros Hxyz.
apply (PQadd_le_mono_r _ _ (x + y)%PQ) in Hxyz.
do 2 rewrite PQadd_assoc in Hxyz.
rewrite PQsub_add in Hxyz; [ | easy ].
rewrite PQadd_add_swap in Hxyz.
rewrite PQsub_add in Hxyz; [ | easy ].
now apply PQadd_le_mono_l in Hxyz.
Qed.
Theorem PQsub_le_mono : ∀ x y z t,
(y < x)%PQ → (t < z)%PQ → (x ≤ z)%PQ → (t ≤ y)%PQ → (x - y ≤ z - t)%PQ.
Proof.
intros * Hyx Htz Hxz Hty.
eapply (PQle_trans _ (z - y)).
-apply PQsub_le_mono_r; [ easy | | easy ].
eapply PQlt_le_trans; [ apply Hyx | apply Hxz ].
-apply PQsub_le_mono_l; [ | easy | easy ].
eapply PQlt_le_trans; [ apply Hyx | apply Hxz ].
Qed.
Theorem PQadd_no_neutral : ∀ x y, (y + x ≠≠ x)%PQ.
Proof.
intros x y Hxy.
unfold "+"%PQ, "=="%PQ, nd in Hxy; simpl in Hxy.
unfold PQadd_num1, PQadd_den1, nd in Hxy.
do 6 rewrite Nat.add_1_r in Hxy.
do 2 (rewrite <- Nat.sub_succ_l in Hxy; [ | simpl; flia ]).
do 2 rewrite Nat.sub_succ, Nat.sub_0_r in Hxy.
rewrite Nat.mul_add_distr_r in Hxy.
rewrite Nat.mul_assoc in Hxy.
apply Nat.add_sub_eq_r in Hxy.
now rewrite Nat.sub_diag in Hxy.
Qed.
Theorem PQsub_no_neutral : ∀ x y, (y < x)%PQ → (x - y ≠≠ x)%PQ.
Proof.
intros *; PQtac1; intros Hyz.
PQtac2; [ | flia Hyz ].
PQtac3.
rewrite <- Nat.sub_succ_l; [ | simpl; flia ].
rewrite Nat.sub_succ, Nat.sub_0_r, Nat.mul_assoc.
intros H.
apply Nat.add_sub_eq_nz in H; [ | simpl; flia ].
rewrite Nat.add_comm, Nat.mul_shuffle0 in H.
rewrite <- Nat.add_0_r in H.
now apply Nat.add_cancel_l in H.
Qed.
Theorem PQadd_sub_same_eq : ∀ px py pz,
(py == pz)%PQ
→ (px + py - pz = px * PQone py * PQone pz)%PQ.
Proof.
intros * Hyz.
unfold "*"%PQ, PQmul_num1, PQmul_den1.
revert Hyz.
PQtac1; intros; PQtac2; [ | simpl; flia ].
PQtac3; do 2 PQtac2; PQtac3; f_equal.
remember (S (PQnum1 px) * S (PQden1 py)) as t.
now rewrite Nat.mul_shuffle0, Hyz, Nat.mul_shuffle0, Nat.add_sub.
Qed.
Theorem PQadd_sub_eq : ∀ x y, (x + y - y = x * PQone y * PQone y)%PQ.
Proof. now intros; rewrite PQadd_sub_same_eq. Qed.
Theorem PQadd_sub : ∀ x y, (x + y - y == x)%PQ.
Proof.
intros x y.
rewrite PQadd_sub_eq.
now do 2 rewrite PQmul_one_r.
Qed.
Theorem PQlt_add_r : ∀ x y, (x < x + y)%PQ.
Proof.
intros.
unfold "<"%PQ, "+"%PQ; simpl.
unfold PQadd_num1, PQadd_den1, nd; simpl.
do 6 rewrite Nat.add_1_r.
do 2 (rewrite <- Nat.sub_succ_l; [ | simpl; flia ]).
do 2 (rewrite Nat.sub_succ, Nat.sub_0_r).
rewrite Nat.mul_add_distr_r.
rewrite Nat.mul_assoc, Nat.mul_shuffle0.
rewrite <- Nat.add_0_r at 1.
apply Nat.add_le_lt_mono; [ easy | simpl; flia ].
Qed.
Theorem PQlt_add_l : ∀ x y, (x < y + x)%PQ.
Proof.
intros.
rewrite PQadd_comm.
apply PQlt_add_r.
Qed.
Theorem PQle_add_r : ∀ x y, (x ≤ x + y)%PQ.
Proof.
intros.
unfold "≤"%PQ, "+"%PQ; simpl.
unfold PQadd_num1, PQadd_den1, nd; simpl.
do 6 rewrite Nat.add_1_r.
do 2 (rewrite <- Nat.sub_succ_l; [ | simpl; flia ]).
do 2 (rewrite Nat.sub_succ, Nat.sub_0_r).
rewrite Nat.mul_add_distr_r.
rewrite Nat.mul_assoc, Nat.mul_shuffle0.
rewrite <- Nat.add_0_r at 1.
apply Nat.add_le_mono; [ easy | simpl; flia ].
Qed.
Theorem PQle_add_l : ∀ x y, (x ≤ y + x)%PQ.
Proof.
intros.
rewrite PQadd_comm.
apply PQle_add_r.
Qed.
Theorem PQsub_lt : ∀ x y, (y < x)%PQ → (x - y < x)%PQ.
Proof.
intros * Hyx.
revert Hyx; PQtac1; intros.
repeat PQtac2.
-rewrite Nat.mul_assoc, Nat.mul_shuffle0.
apply Nat.mul_lt_mono_pos_r; [ apply Nat.lt_0_succ | ].
apply Nat.sub_lt; [ | simpl; apply Nat.lt_0_succ ].
now apply Nat.lt_le_incl.
-flia Hyx.
Qed.
Theorem PQsub_add_distr : ∀ x y z,
(y < x)%PQ → (x - (y + z))%PQ = (x - y - z)%PQ.
Proof.
intros * Hyx.
revert Hyx; PQtac1; intros.
repeat PQtac2; PQtac3; [ f_equal; flia | flia Hyx | simpl; flia ].
Qed.
Theorem PQsub_sub_swap : ∀ x y z,
(y < x)%PQ → (z < x)%PQ → (x - y - z)%PQ = (x - z - y)%PQ.
Proof.
intros * Hyx Hzx.
rewrite <- PQsub_add_distr; [ | easy ].
rewrite <- PQsub_add_distr; [ now rewrite PQadd_comm | easy ].
Qed.
Theorem PQsub_sub_distr : ∀ x y z,
(z < y)%PQ → (y - z < x)%PQ → (x - (y - z))%PQ = (x + z - y)%PQ.
Proof.
intros * Hzy Hyzx.
revert Hzy Hyzx; PQtac1; intros.
rewrite Nat_sub_sub_swap in Hyzx.
do 2 (rewrite <- Nat.sub_succ_l in Hyzx; [ | flia Hzy ]).
rewrite <- Nat.sub_succ_l in Hyzx; [ | simpl; flia ].
do 2 rewrite Nat.sub_succ, Nat.sub_0_r in Hyzx.
rewrite Nat.mul_sub_distr_r, Nat.mul_assoc in Hyzx.
repeat PQtac2; PQtac3; [ | simpl; flia | ].
-f_equal; [ f_equal | now rewrite Nat.mul_shuffle0 ].
rewrite Nat_sub_sub_assoc.
+f_equal; [ | now rewrite Nat.mul_shuffle0 ].
now f_equal; rewrite Nat.mul_shuffle0.
+split; [ | flia Hyzx ].
now apply Nat.mul_le_mono_r, Nat.lt_le_incl.
-flia Hzy.
Qed.
Theorem PQadd_sub_assoc : ∀ x y z,
(z < y)%PQ → (x + (y - z))%PQ = (x + y - z)%PQ.
Proof.
intros * Hzy.
revert Hzy; PQtac1; intros.
repeat PQtac2; [ | simpl; flia | flia Hzy ].
PQtac3.
f_equal; f_equal.
rewrite Nat.add_sub_assoc.
-f_equal; [ f_equal; apply Nat.mul_shuffle0 | apply Nat.mul_shuffle0 ].
-now apply Nat.mul_le_mono_r, Nat.lt_le_incl.
Qed.
Theorem PQadd_sub_swap : ∀ x y z, (z < x)%PQ → (x + y - z = x - z + y)%PQ.
Proof.
intros * Hzx.
revert Hzx; PQtac1; intros.
repeat PQtac2; [ | flia Hzx | simpl; flia ].
PQtac3.
f_equal; [ f_equal | now rewrite Nat.mul_shuffle0 ].
rewrite Nat.add_sub_swap.
-f_equal; f_equal; apply Nat.mul_shuffle0.
-setoid_rewrite Nat.mul_shuffle0.
rewrite Nat.mul_shuffle0.
apply Nat.mul_le_mono_pos_r; [ apply Nat.lt_0_succ | ].
now apply Nat.lt_le_incl.
Qed.
Theorem PQadd_cancel_l_eq : ∀ x y z,
(z + x == z + y)%PQ → (x * PQone y = y * PQone x)%PQ.
Proof.
intros * H.
revert H; PQtac1; intros.
do 4 (rewrite <- Nat.sub_succ_l in H; [ | simpl; flia ]).
do 4 rewrite Nat.sub_succ, Nat.sub_0_r in H.
setoid_rewrite Nat.mul_comm in H.
do 2 rewrite <- Nat.mul_assoc in H.
apply Nat.mul_cancel_l in H; [ | easy ].
setoid_rewrite Nat.mul_comm in H.
do 2 rewrite Nat.mul_add_distr_r in H.
rewrite Nat.mul_shuffle0 in H.
apply Nat.add_cancel_l in H.
setoid_rewrite Nat.mul_shuffle0 in H.
apply Nat.mul_cancel_r in H; [ | easy ].
unfold "*"%PQ, PQone, PQmul_num1, PQmul_den1; simpl.
PQtac1; rewrite H; f_equal.
now rewrite Nat.mul_comm.
Qed.
Theorem PQadd_cancel_l : ∀ x y z, (z + x == z + y)%PQ ↔ (x == y)%PQ.
Proof.
intros.
split; intros H; [ | now rewrite H ].
specialize (PQadd_cancel_l_eq _ _ _ H) as H1.
unfold "*"%PQ, PQone, PQmul_num1, PQmul_den1 in H1; simpl in H1.
injection H1; clear H1; intros H1 H2.
revert H2; PQtac1; intros.
simpl in H2; simpl; do 2 rewrite Nat.sub_0_r in H2.
now rewrite H2.
Qed.
(* mouais, chais pas si PQadd_cancel_l ci-dessus est très convainquant ;
est-ce une bonne idée de passer par PQadd_cancel_l_eq ?
du coup, chais pas, mais je ne le fais pas pour PQadd_cancel_r
ci-dessous *)
Theorem PQadd_cancel_r : ∀ x y z, (x + z == y + z ↔ x == y)%PQ.
Proof.
intros.
setoid_rewrite PQadd_comm.
apply PQadd_cancel_l.
Qed.
Arguments PQadd_cancel_r x%PQ y%PQ z%PQ.
Theorem PQsub_cancel_l : ∀ x y z,
(y < x)%PQ → (z < x)%PQ → (x - y == x - z)%PQ ↔ (y == z)%PQ.
Proof.
intros * Hyx Hzx.
split; intros H.
-apply (PQadd_cancel_r _ _ z) in H.
rewrite PQsub_add in H; [ | easy ].
apply (PQadd_cancel_r _ _ (x - y)).
setoid_rewrite PQadd_comm.
rewrite PQsub_add; [ | easy ].
now symmetry.
-apply (PQadd_cancel_r _ _ z).
rewrite PQsub_add; [ | easy ].
apply (PQadd_cancel_r _ _ (x - y)) in H.
setoid_rewrite PQadd_comm in H.
rewrite PQsub_add in H; [ | easy ].