├── .gitignore ├── Analysis └── KaisekiNyuumonn │ ├── KaisekiNyuumonn1_1.v │ ├── KaisekiNyuumonn1_2.v │ └── KaisekiNyuumonn2.v ├── BasicNotation ├── Parity.v └── Permutation.v ├── BasicProperty ├── MappingProperty.v └── NatProperty.v ├── LICENSE ├── LibraryExtension ├── ComposeExtension.v ├── DatatypesExtension.v └── EnsemblesExtension.v ├── LinearAlgebra ├── Matrix.v └── SenkeiDaisuunoSekai │ └── SenkeiDaisuunoSekai1.v ├── Makefile ├── MyAlgebraicStructure ├── MyField.v └── MyVectorSpace.v ├── Paper └── Least_upper_bound_of_truncation_error_of_low-rank_matrix_approximation_algorithm_using_QR_decomposition_with_pivoting.v ├── README.md ├── Tools ├── BasicTools.v ├── MyProd.v └── MySum.v └── Topology └── ShuugouIsouNyuumonn ├── ShuugouIsouNyuumonn1.v ├── ShuugouIsouNyuumonn1AC.v ├── ShuugouIsouNyuumonn2.v └── ShuugouIsouNyuumonn2AC.v /.gitignore: -------------------------------------------------------------------------------- 1 | *vo 2 | *vok 3 | *vos 4 | *glob 5 | *aux -------------------------------------------------------------------------------- /BasicNotation/Parity.v: -------------------------------------------------------------------------------- 1 | Add LoadPath "Tools" as Tools. 2 | 3 | From mathcomp Require Import ssreflect. 4 | Require Import Tools.MySum. 5 | 6 | Inductive Parity := 7 | | ON : Parity 8 | | OFF : Parity. 9 | 10 | Definition ParityXOR (x y : Parity) := match x with 11 | | ON => match y with 12 | | ON => OFF 13 | | OFF => ON 14 | end 15 | | OFF => match y with 16 | | ON => ON 17 | | OFF => OFF 18 | end 19 | end. 20 | 21 | Lemma ParityXOR_comm : forall (x y : Parity), ParityXOR x y = ParityXOR y x. 22 | Proof. 23 | elim. 24 | elim. 25 | reflexivity. 26 | reflexivity. 27 | elim. 28 | reflexivity. 29 | reflexivity. 30 | Qed. 31 | 32 | Lemma ParityXOR_O_r : forall (x : Parity), ParityXOR x OFF = x. 33 | Proof. 34 | elim. 35 | reflexivity. 36 | reflexivity. 37 | Qed. 38 | 39 | Lemma ParityXOR_assoc : forall (x y z : Parity), ParityXOR (ParityXOR x y) z = ParityXOR x (ParityXOR y z). 40 | Proof. 41 | elim. 42 | elim. 43 | elim. 44 | reflexivity. 45 | reflexivity. 46 | elim. 47 | reflexivity. 48 | reflexivity. 49 | elim. 50 | elim. 51 | reflexivity. 52 | reflexivity. 53 | elim. 54 | reflexivity. 55 | reflexivity. 56 | Qed. 57 | 58 | Definition ParityXORCM := mkCommutativeMonoid Parity OFF ParityXOR ParityXOR_comm ParityXOR_O_r ParityXOR_assoc. 59 | -------------------------------------------------------------------------------- /BasicNotation/Permutation.v: -------------------------------------------------------------------------------- 1 | Add LoadPath "Tools" as Tools. 2 | Add LoadPath "BasicProperty" as BasicProperty. 3 | Add LoadPath "BasicNotation" as BasicNotation. 4 | 5 | From mathcomp Require Import ssreflect. 6 | Require Import Coq.Program.Basics. 7 | Require Import Coq.Logic.ClassicalDescription. 8 | Require Import Coq.Logic.FunctionalExtensionality. 9 | Require Import Coq.Sets.Ensembles. 10 | Require Import Coq.Sets.Finite_sets. 11 | Require Import Coq.Sets.Finite_sets_facts. 12 | Require Import Coq.Sets.Image. 13 | Require Import Coq.Arith.Le. 14 | Require Import Tools.MySum. 15 | Require Import BasicProperty.MappingProperty. 16 | Require Import BasicNotation.Parity. 17 | 18 | Definition Permutation (N : nat) := {f : {n : nat | n < N} -> {n : nat | n < N} | Bijective f}. 19 | 20 | Lemma PermutationFinite : forall (N : nat), Finite (Permutation N) (Full_set (Permutation N)). 21 | Proof. 22 | move=> N. 23 | apply (FiniteSigSame ({n : nat | n < N} -> {n : nat | n < N})). 24 | apply (Finite_downward_closed ({n : nat | n < N} -> {n : nat | n < N}) (Full_set ({n : nat | n < N} -> {n : nat | n < N}))). 25 | apply (CountFiniteBijective ({n : nat | n < N} -> {n : nat | n < N})). 26 | exists (PeanoNat.Nat.pow N N). 27 | elim (CountPow N N). 28 | move=> f. 29 | elim. 30 | move=> g H1. 31 | exists g. 32 | exists f. 33 | apply conj. 34 | apply (proj2 H1). 35 | apply (proj1 H1). 36 | move=> f H1. 37 | apply (Full_intro ({n : nat | n < N} -> {n : nat | n < N}) f). 38 | Qed. 39 | 40 | Definition PermutationCompose (N : nat) (f g : Permutation N) := exist (fun (h : {n : nat | n < N} -> {n : nat | n < N}) => Bijective h) (compose (proj1_sig f) (proj1_sig g)) (BijChain {n : nat | n < N} {n : nat | n < N} {n : nat | n < N} (proj1_sig g) (proj1_sig f) (proj2_sig g) (proj2_sig f)). 41 | 42 | Lemma PermutationIDSub : forall (N : nat), Bijective (fun (k : {n : nat | n < N}) => k). 43 | Proof. 44 | move=> N. 45 | exists (fun k : {n : nat | n < N} => k). 46 | apply conj. 47 | move=> x. 48 | reflexivity. 49 | move=> y. 50 | reflexivity. 51 | Qed. 52 | 53 | Definition PermutationID (N : nat) := exist (fun (f : {n : nat | n < N} -> {n : nat | n < N}) => Bijective f) (fun (k : {n : nat | n < N}) => k) (PermutationIDSub N). 54 | 55 | Lemma PermutationInvSub : forall (N : nat) (f : Permutation N), Bijective (proj1_sig (BijectiveInvExist {n : nat | n < N} {n : nat | n < N} (proj1_sig f) (proj2_sig f))). 56 | Proof. 57 | move=> N f. 58 | exists (proj1_sig f). 59 | apply conj. 60 | apply (proj2 (proj2_sig (BijectiveInvExist {n : nat | n < N} {n : nat | n < N} (proj1_sig f) (proj2_sig f)))). 61 | apply (proj1 (proj2_sig (BijectiveInvExist {n : nat | n < N} {n : nat | n < N} (proj1_sig f) (proj2_sig f)))). 62 | Qed. 63 | 64 | Definition PermutationInv (N : nat) (f : Permutation N) := exist (fun (f : {n : nat | n < N} -> {n : nat | n < N}) => Bijective f) (proj1_sig (BijectiveInvExist {n : nat | n < N} {n : nat | n < N} (proj1_sig f) (proj2_sig f))) (PermutationInvSub N f). 65 | 66 | Lemma PermutationCompose_assoc : forall (N : nat) (f g h : Permutation N), PermutationCompose N (PermutationCompose N f g) h = PermutationCompose N f (PermutationCompose N g h). 67 | Proof. 68 | move=> N f g h. 69 | apply sig_map. 70 | reflexivity. 71 | Qed. 72 | 73 | Lemma PermutationCompose_O_r : forall (N : nat) (f : Permutation N), PermutationCompose N f (PermutationID N) = f. 74 | Proof. 75 | move=> N f. 76 | apply sig_map. 77 | reflexivity. 78 | Qed. 79 | 80 | Lemma PermutationCompose_O_l : forall (N : nat) (f : Permutation N), PermutationCompose N (PermutationID N) f = f. 81 | Proof. 82 | move=> N f. 83 | apply sig_map. 84 | reflexivity. 85 | Qed. 86 | 87 | Lemma PermutationCompose_inv_r : forall (N : nat) (f : Permutation N), PermutationCompose N f (PermutationInv N f) = (PermutationID N). 88 | Proof. 89 | move=> N f. 90 | apply sig_map. 91 | apply functional_extensionality. 92 | apply (proj2 (proj2_sig (BijectiveInvExist {n : nat | n < N} {n : nat | n < N} (proj1_sig f) (proj2_sig f)))). 93 | Qed. 94 | 95 | Lemma PermutationCompose_inv_l : forall (N : nat) (f : Permutation N), PermutationCompose N (PermutationInv N f) f = (PermutationID N). 96 | Proof. 97 | move=> N f. 98 | apply sig_map. 99 | apply functional_extensionality. 100 | apply (proj1 (proj2_sig (BijectiveInvExist {n : nat | n < N} {n : nat | n < N} (proj1_sig f) (proj2_sig f)))). 101 | Qed. 102 | 103 | Lemma PermutationSwapSub : forall (N : nat) (x y : {n : nat | n < N}), Bijective (fun (k : {n : nat | n < N}) => match excluded_middle_informative (k = x) with 104 | | left _ => y 105 | | right _ => match excluded_middle_informative (k = y) with 106 | | left _ => x 107 | | right _ => k 108 | end 109 | end). 110 | Proof. 111 | move=> N x y. 112 | exists (fun (k : {n : nat | n < N}) => match excluded_middle_informative (k = x) with 113 | | left _ => y 114 | | right _ => match excluded_middle_informative (k = y) with 115 | | left _ => x 116 | | right _ => k 117 | end 118 | end). 119 | suff: (forall (k : {n : nat | n < N}), compose (fun (k : {n : nat | n < N}) => match excluded_middle_informative (k = x) with 120 | | left _ => y 121 | | right _ => match excluded_middle_informative (k = y) with 122 | | left _ => x 123 | | right _ => k 124 | end 125 | end) (fun (k : {n : nat | n < N}) => match excluded_middle_informative (k = x) with 126 | | left _ => y 127 | | right _ => match excluded_middle_informative (k = y) with 128 | | left _ => x 129 | | right _ => k 130 | end 131 | end) k = k). 132 | move=> H1. 133 | apply conj. 134 | apply H1. 135 | apply H1. 136 | move=> k. 137 | unfold compose. 138 | elim (excluded_middle_informative (k = x)). 139 | move=> H1. 140 | elim (excluded_middle_informative (y = x)). 141 | rewrite H1. 142 | apply. 143 | move=> H2. 144 | elim (excluded_middle_informative (y = y)). 145 | move=> H3. 146 | rewrite H1. 147 | reflexivity. 148 | move=> H3. 149 | apply False_ind. 150 | apply H3. 151 | reflexivity. 152 | move=> H1. 153 | elim (excluded_middle_informative (k = y)). 154 | move=> H2. 155 | elim (excluded_middle_informative (x = x)). 156 | move=> H3. 157 | rewrite H2. 158 | reflexivity. 159 | move=> H3. 160 | apply False_ind. 161 | apply H3. 162 | reflexivity. 163 | move=> H2. 164 | elim (excluded_middle_informative (k = x)). 165 | move=> H3. 166 | apply False_ind. 167 | apply (H1 H3). 168 | move=> H3. 169 | elim (excluded_middle_informative (k = y)). 170 | move=> H4. 171 | apply False_ind. 172 | apply (H2 H4). 173 | move=> H4. 174 | reflexivity. 175 | Qed. 176 | 177 | Definition PermutationSwap (N : nat) (x y : {n : nat | n < N}) := exist (fun (f : {n : nat | n < N} -> {n : nat | n < N}) => Bijective f) (fun (k : {n : nat | n < N}) => match excluded_middle_informative (k = x) with 178 | | left _ => y 179 | | right _ => match excluded_middle_informative (k = y) with 180 | | left _ => x 181 | | right _ => k 182 | end 183 | end) (PermutationSwapSub N x y). 184 | 185 | Lemma PermutationSwap_comm : forall (N : nat) (x y : {n : nat | n < N}), PermutationSwap N x y = PermutationSwap N y x. 186 | Proof. 187 | move=> N x y. 188 | apply sig_map. 189 | simpl. 190 | apply functional_extensionality. 191 | move=> k. 192 | elim (excluded_middle_informative (k = x)). 193 | elim (excluded_middle_informative (k = y)). 194 | move=> H1 H2. 195 | rewrite - H1. 196 | apply H2. 197 | move=> H1 H2. 198 | reflexivity. 199 | move=> H1. 200 | reflexivity. 201 | Qed. 202 | 203 | Lemma PermutationSwap_same : forall (N : nat) (x : {n : nat | n < N}), PermutationSwap N x x = PermutationID N. 204 | Proof. 205 | move=> N x. 206 | apply sig_map. 207 | simpl. 208 | apply functional_extensionality. 209 | move=> k. 210 | elim (excluded_middle_informative (k = x)). 211 | move=> H1. 212 | rewrite H1. 213 | reflexivity. 214 | move=> H1. 215 | reflexivity. 216 | Qed. 217 | 218 | Lemma PermutationParitySub : forall (N : nat), Finite ({n : nat | n < N} * {n : nat | n < N}) (fun (xy : {n : nat | n < N} * {n : nat | n < N}) => proj1_sig (fst xy) < proj1_sig (snd xy)). 219 | Proof. 220 | move=> N. 221 | apply (Finite_downward_closed ({n : nat | n < N} * {n : nat | n < N}) (Full_set ({n : nat | n < N} * {n : nat | n < N}))). 222 | apply (cardinal_finite ({n : nat | n < N} * {n : nat | n < N}) (Full_set ({n : nat | n < N} * {n : nat | n < N})) (N * N)). 223 | apply (proj1 (CountCardinalBijective ({n : nat | n < N} * {n : nat | n < N}) (N * N))). 224 | elim (proj2_sig (CountMult N N)). 225 | move=> f H1. 226 | exists f. 227 | exists (proj1_sig (CountMult N N)). 228 | apply conj. 229 | apply (proj2 H1). 230 | apply (proj1 H1). 231 | move=> xy H1. 232 | apply (Full_intro ({n : nat | n < N} * {n : nat | n < N}) xy). 233 | Qed. 234 | 235 | Definition PermutationParity (N : nat) (f : Permutation N) := MySumF2 ({n : nat | n < N} * {n : nat | n < N}) (exist (Finite ({n : nat | n < N} * {n : nat | n < N})) (fun (xy : {n : nat | n < N} * {n : nat | n < N}) => proj1_sig (fst xy) < proj1_sig (snd xy)) (PermutationParitySub N)) ParityXORCM (fun (xy : {n : nat | n < N} * {n : nat | n < N}) => match excluded_middle_informative (proj1_sig (proj1_sig f (fst xy)) < proj1_sig (proj1_sig f (snd xy))) with 236 | | left _ => OFF 237 | | right _ => ON 238 | end). 239 | 240 | Lemma PermutationComposeParity : forall (N : nat) (f g : Permutation N), PermutationParity N (PermutationCompose N f g) = ParityXOR (PermutationParity N f) (PermutationParity N g). 241 | Proof. 242 | move=> N f g. 243 | unfold PermutationParity. 244 | suff: ((exist (Finite ({n : nat | n < N} * {n : nat | n < N})) (fun xy : {n : nat | n < N} * {n : nat | n < N} => proj1_sig (fst xy) < proj1_sig (snd xy)) (PermutationParitySub N)) = (FiniteIm ({n : nat | n < N} * {n : nat | n < N}) ({n : nat | n < N} * {n : nat | n < N}) (fun (xy : {n : nat | n < N} * {n : nat | n < N}) => match excluded_middle_informative (proj1_sig (proj1_sig g (fst xy)) < proj1_sig (proj1_sig g (snd xy))) with 245 | | left _ => (proj1_sig g (fst xy), proj1_sig g (snd xy)) 246 | | right _ => (proj1_sig g (snd xy), proj1_sig g (fst xy)) 247 | end) (exist (Finite ({n : nat | n < N} * {n : nat | n < N})) (fun xy : {n : nat | n < N} * {n : nat | n < N} => proj1_sig (fst xy) < proj1_sig (snd xy)) (PermutationParitySub N)))). 248 | move=> H1. 249 | rewrite {2} H1. 250 | rewrite - (MySumF2BijectiveSame2 ({n : nat | n < N} * {n : nat | n < N}) ({n : nat | n < N} * {n : nat | n < N}) (exist (Finite ({n : nat | n < N} * {n : nat | n < N})) (fun xy : {n : nat | n < N} * {n : nat | n < N} => proj1_sig (fst xy) < proj1_sig (snd xy)) (PermutationParitySub N)) (fun (xy : {n : nat | n < N} * {n : nat | n < N}) => match excluded_middle_informative (proj1_sig (proj1_sig g (fst xy)) < proj1_sig (proj1_sig g (snd xy))) with 251 | | left _ => (proj1_sig g (fst xy), proj1_sig g (snd xy)) 252 | | right _ => (proj1_sig g (snd xy), proj1_sig g (fst xy)) 253 | end) ParityXORCM (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig f (fst xy)) < proj1_sig (proj1_sig f (snd xy))) with 254 | | left _ => OFF 255 | | right _ => ON 256 | end)). 257 | apply (FiniteSetInduction ({n : nat | n < N} * {n : nat | n < N}) (exist (Finite ({n : nat | n < N} * {n : nat | n < N})) (fun xy : {n : nat | n < N} * {n : nat | n < N} => proj1_sig (fst xy) < proj1_sig (snd xy)) (PermutationParitySub N))). 258 | apply conj. 259 | rewrite MySumF2Empty. 260 | rewrite MySumF2Empty. 261 | rewrite MySumF2Empty. 262 | reflexivity. 263 | move=> B b H2 H3 H4 H5. 264 | rewrite MySumF2Add. 265 | rewrite MySumF2Add. 266 | rewrite MySumF2Add. 267 | rewrite H5. 268 | simpl. 269 | suff: ((match excluded_middle_informative (proj1_sig (compose (proj1_sig f) (proj1_sig g) (fst b)) < proj1_sig (compose (proj1_sig f) (proj1_sig g) (snd b))) with 270 | | left _ => OFF 271 | | right _ => ON 272 | end) = ParityXOR (compose (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig f (fst xy)) < proj1_sig (proj1_sig f (snd xy))) with 273 | | left _ => OFF 274 | | right _ => ON 275 | end) (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig g (fst xy)) < proj1_sig (proj1_sig g (snd xy))) with 276 | | left _ => (proj1_sig g (fst xy), proj1_sig g (snd xy)) 277 | | right _ => (proj1_sig g (snd xy), proj1_sig g (fst xy)) 278 | end) b) (match excluded_middle_informative (proj1_sig (proj1_sig g (fst b)) < proj1_sig (proj1_sig g (snd b))) with 279 | | left _ => OFF 280 | | right _ => ON 281 | end)). 282 | move=> H6. 283 | rewrite H6. 284 | rewrite - (ParityXOR_assoc (ParityXOR (MySumF2 ({n : nat | n < N} * {n : nat | n < N}) B ParityXORCM (compose (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig f (fst xy)) < proj1_sig (proj1_sig f (snd xy))) with 285 | | left _ => OFF 286 | | right _ => ON 287 | end) (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig g (fst xy)) < proj1_sig (proj1_sig g (snd xy))) with 288 | | left _ => (proj1_sig g (fst xy), proj1_sig g (snd xy)) 289 | | right _ => (proj1_sig g (snd xy), proj1_sig g (fst xy)) 290 | end))) (MySumF2 ({n : nat | n < N} * {n : nat | n < N}) B ParityXORCM (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig g (fst xy)) < proj1_sig (proj1_sig g (snd xy))) with 291 | | left _ => OFF 292 | | right _ => ON 293 | end))) (compose (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig f (fst xy)) < proj1_sig (proj1_sig f (snd xy))) with 294 | | left _ => OFF 295 | | right _ => ON 296 | end) (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig g (fst xy)) < proj1_sig (proj1_sig g (snd xy))) with 297 | | left _ => (proj1_sig g (fst xy), proj1_sig g (snd xy)) 298 | | right _ => (proj1_sig g (snd xy), proj1_sig g (fst xy)) 299 | end) b) (match excluded_middle_informative (proj1_sig (proj1_sig g (fst b)) < proj1_sig (proj1_sig g (snd b))) with 300 | | left _ => OFF 301 | | right _ => ON 302 | end)). 303 | rewrite (ParityXOR_assoc (MySumF2 ({n : nat | n < N} * {n : nat | n < N}) B ParityXORCM (compose (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig f (fst xy)) < proj1_sig (proj1_sig f (snd xy))) with 304 | | left _ => OFF 305 | | right _ => ON 306 | end) (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig g (fst xy)) < proj1_sig (proj1_sig g (snd xy))) with 307 | | left _ => (proj1_sig g (fst xy), proj1_sig g (snd xy)) 308 | | right _ => (proj1_sig g (snd xy), proj1_sig g (fst xy)) 309 | end))) (MySumF2 ({n : nat | n < N} * {n : nat | n < N}) B ParityXORCM (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig g (fst xy)) < proj1_sig (proj1_sig g (snd xy))) with 310 | | left _ => OFF 311 | | right _ => ON 312 | end)) (compose (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig f (fst xy)) < proj1_sig (proj1_sig f (snd xy))) with 313 | | left _ => OFF 314 | | right _ => ON 315 | end) (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig g (fst xy)) < proj1_sig (proj1_sig g (snd xy))) with 316 | | left _ => (proj1_sig g (fst xy), proj1_sig g (snd xy)) 317 | | right _ => (proj1_sig g (snd xy), proj1_sig g (fst xy)) 318 | end) b)). 319 | rewrite (ParityXOR_comm (MySumF2 ({n : nat | n < N} * {n : nat | n < N}) B ParityXORCM (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig g (fst xy)) < proj1_sig (proj1_sig g (snd xy))) with 320 | | left _ => OFF 321 | | right _ => ON 322 | end)) (compose (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig f (fst xy)) < proj1_sig (proj1_sig f (snd xy))) with 323 | | left _ => OFF 324 | | right _ => ON 325 | end) (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig g (fst xy)) < proj1_sig (proj1_sig g (snd xy))) with 326 | | left _ => (proj1_sig g (fst xy), proj1_sig g (snd xy)) 327 | | right _ => (proj1_sig g (snd xy), proj1_sig g (fst xy)) 328 | end) b)). 329 | rewrite - (ParityXOR_assoc (MySumF2 ({n : nat | n < N} * {n : nat | n < N}) B ParityXORCM (compose (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig f (fst xy)) < proj1_sig (proj1_sig f (snd xy))) with 330 | | left _ => OFF 331 | | right _ => ON 332 | end) (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig g (fst xy)) < proj1_sig (proj1_sig g (snd xy))) with 333 | | left _ => (proj1_sig g (fst xy), proj1_sig g (snd xy)) 334 | | right _ => (proj1_sig g (snd xy), proj1_sig g (fst xy)) 335 | end))) (compose (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig f (fst xy)) < proj1_sig (proj1_sig f (snd xy))) with 336 | | left _ => OFF 337 | | right _ => ON 338 | end) (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig g (fst xy)) < proj1_sig (proj1_sig g (snd xy))) with 339 | | left _ => (proj1_sig g (fst xy), proj1_sig g (snd xy)) 340 | | right _ => (proj1_sig g (snd xy), proj1_sig g (fst xy)) 341 | end) b) (MySumF2 ({n : nat | n < N} * {n : nat | n < N}) B ParityXORCM (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig g (fst xy)) < proj1_sig (proj1_sig g (snd xy))) with 342 | | left _ => OFF 343 | | right _ => ON 344 | end))). 345 | apply ParityXOR_assoc. 346 | unfold compose. 347 | elim (excluded_middle_informative (proj1_sig (proj1_sig g (fst b)) < proj1_sig (proj1_sig g (snd b)))). 348 | move=> H6. 349 | rewrite ParityXOR_O_r. 350 | reflexivity. 351 | simpl. 352 | move=> H6. 353 | elim (excluded_middle_informative (proj1_sig (proj1_sig f (proj1_sig g (fst b))) < proj1_sig (proj1_sig f (proj1_sig g (snd b))))). 354 | elim (excluded_middle_informative (proj1_sig (proj1_sig f (proj1_sig g (snd b))) < proj1_sig (proj1_sig f (proj1_sig g (fst b))))). 355 | move=> H7 H8. 356 | apply False_ind. 357 | apply (lt_irrefl (proj1_sig (proj1_sig f (proj1_sig g (snd b)))) (lt_trans (proj1_sig (proj1_sig f (proj1_sig g (snd b)))) (proj1_sig (proj1_sig f (proj1_sig g (fst b)))) (proj1_sig (proj1_sig f (proj1_sig g (snd b)))) H7 H8)). 358 | move=> H7 H8. 359 | reflexivity. 360 | elim (excluded_middle_informative (proj1_sig (proj1_sig f (proj1_sig g (snd b))) < proj1_sig (proj1_sig f (proj1_sig g (fst b))))). 361 | move=> H7 H8. 362 | reflexivity. 363 | move=> H7 H8. 364 | apply False_ind. 365 | apply (lt_not_le (proj1_sig (fst b)) (proj1_sig (snd b)) H3). 366 | suff: ((snd b) = (fst b)). 367 | move=> H9. 368 | rewrite H9. 369 | apply (le_n (proj1_sig (fst b))). 370 | apply (BijInj {n : nat | n < N} {n : nat | n < N} (proj1_sig g) (proj2_sig g)). 371 | apply (BijInj {n : nat | n < N} {n : nat | n < N} (proj1_sig f) (proj2_sig f)). 372 | apply sig_map. 373 | elim (le_or_lt (proj1_sig (proj1_sig f (proj1_sig g (snd b)))) (proj1_sig (proj1_sig f (proj1_sig g (fst b))))). 374 | move=> H9. 375 | elim (le_lt_or_eq (proj1_sig (proj1_sig f (proj1_sig g (snd b)))) (proj1_sig (proj1_sig f (proj1_sig g (fst b)))) H9). 376 | move=> H10. 377 | apply False_ind. 378 | apply (H7 H10). 379 | apply. 380 | move=> H9. 381 | apply False_ind. 382 | apply (H8 H9). 383 | apply H4. 384 | apply H4. 385 | apply H4. 386 | simpl. 387 | move=> u1 u2 H2 H3. 388 | elim (excluded_middle_informative (proj1_sig (proj1_sig g (fst u1)) < proj1_sig (proj1_sig g (snd u1)))). 389 | elim (excluded_middle_informative (proj1_sig (proj1_sig g (fst u2)) < proj1_sig (proj1_sig g (snd u2)))). 390 | move=> H4 H5 H6. 391 | apply injective_projections. 392 | apply (BijInj {n : nat | n < N} {n : nat | n < N} (proj1_sig g) (proj2_sig g)). 393 | suff: (proj1_sig g (fst u1) = fst (proj1_sig g (fst u1), proj1_sig g (snd u1))). 394 | move=> H7. 395 | rewrite H7. 396 | rewrite H6. 397 | reflexivity. 398 | reflexivity. 399 | apply (BijInj {n : nat | n < N} {n : nat | n < N} (proj1_sig g) (proj2_sig g)). 400 | suff: (proj1_sig g (snd u1) = snd (proj1_sig g (fst u1), proj1_sig g (snd u1))). 401 | move=> H7. 402 | rewrite H7. 403 | rewrite H6. 404 | reflexivity. 405 | reflexivity. 406 | move=> H4 H5 H6. 407 | apply False_ind. 408 | apply (lt_irrefl (proj1_sig (fst u1))). 409 | apply (lt_trans (proj1_sig (fst u1)) (proj1_sig (snd u1)) (proj1_sig (fst u1)) H2). 410 | suff: (snd u1 = fst u2). 411 | move=> H7. 412 | suff: (fst u1 = snd u2). 413 | move=> H8. 414 | rewrite H7. 415 | rewrite H8. 416 | apply H3. 417 | apply (BijInj {n : nat | n < N} {n : nat | n < N} (proj1_sig g) (proj2_sig g)). 418 | suff: (proj1_sig g (fst u1) = fst (proj1_sig g (fst u1), proj1_sig g (snd u1))). 419 | move=> H8. 420 | rewrite H8. 421 | rewrite H6. 422 | reflexivity. 423 | reflexivity. 424 | apply (BijInj {n : nat | n < N} {n : nat | n < N} (proj1_sig g) (proj2_sig g)). 425 | suff: (proj1_sig g (snd u1) = snd (proj1_sig g (fst u1), proj1_sig g (snd u1))). 426 | move=> H7. 427 | rewrite H7. 428 | rewrite H6. 429 | reflexivity. 430 | reflexivity. 431 | elim (excluded_middle_informative (proj1_sig (proj1_sig g (fst u2)) < proj1_sig (proj1_sig g (snd u2)))). 432 | move=> H4 H5 H6. 433 | apply False_ind. 434 | apply (lt_irrefl (proj1_sig (fst u2))). 435 | apply (lt_trans (proj1_sig (fst u2)) (proj1_sig (snd u2)) (proj1_sig (fst u2)) H3). 436 | suff: (snd u2 = fst u1). 437 | move=> H7. 438 | suff: (fst u2 = snd u1). 439 | move=> H8. 440 | rewrite H7. 441 | rewrite H8. 442 | apply H2. 443 | apply (BijInj {n : nat | n < N} {n : nat | n < N} (proj1_sig g) (proj2_sig g)). 444 | suff: (proj1_sig g (fst u2) = fst (proj1_sig g (fst u2), proj1_sig g (snd u2))). 445 | move=> H8. 446 | rewrite H8. 447 | rewrite - H6. 448 | reflexivity. 449 | reflexivity. 450 | apply (BijInj {n : nat | n < N} {n : nat | n < N} (proj1_sig g) (proj2_sig g)). 451 | suff: (proj1_sig g (snd u2) = snd (proj1_sig g (fst u2), proj1_sig g (snd u2))). 452 | move=> H7. 453 | rewrite H7. 454 | rewrite - H6. 455 | reflexivity. 456 | reflexivity. 457 | move=> H4 H5 H6. 458 | apply injective_projections. 459 | apply (BijInj {n : nat | n < N} {n : nat | n < N} (proj1_sig g) (proj2_sig g)). 460 | suff: (proj1_sig g (fst u1) = snd (proj1_sig g (snd u1), proj1_sig g (fst u1))). 461 | move=> H7. 462 | rewrite H7. 463 | rewrite H6. 464 | reflexivity. 465 | reflexivity. 466 | apply (BijInj {n : nat | n < N} {n : nat | n < N} (proj1_sig g) (proj2_sig g)). 467 | suff: (proj1_sig g (snd u1) = fst (proj1_sig g (snd u1), proj1_sig g (fst u1))). 468 | move=> H7. 469 | rewrite H7. 470 | rewrite H6. 471 | reflexivity. 472 | reflexivity. 473 | apply sig_map. 474 | simpl. 475 | apply Extensionality_Ensembles. 476 | apply conj. 477 | move=> k H1. 478 | elim (proj2_sig g). 479 | move=> ginv H2. 480 | elim (le_or_lt (proj1_sig (ginv (fst k))) (proj1_sig (ginv (snd k)))). 481 | move=> H3. 482 | elim (le_lt_or_eq (proj1_sig (ginv (fst k))) (proj1_sig (ginv (snd k)))). 483 | move=> H4. 484 | apply (Im_intro ({n : nat | n < N} * {n : nat | n < N}) ({n : nat | n < N} * {n : nat | n < N}) (fun (xy : {n : nat | n < N} * {n : nat | n < N}) => proj1_sig (fst xy) < proj1_sig (snd xy)) (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig g (fst xy)) < proj1_sig (proj1_sig g (snd xy))) with 485 | | left _ => (proj1_sig g (fst xy), proj1_sig g (snd xy)) 486 | | right _ => (proj1_sig g (snd xy), proj1_sig g (fst xy)) 487 | end) (ginv (fst k), ginv (snd k))). 488 | apply H4. 489 | simpl. 490 | elim (excluded_middle_informative (proj1_sig (proj1_sig g (ginv (fst k))) < proj1_sig (proj1_sig g (ginv (snd k))))). 491 | move=> H5. 492 | apply injective_projections. 493 | rewrite (proj2 H2 (fst k)). 494 | reflexivity. 495 | rewrite (proj2 H2 (snd k)). 496 | reflexivity. 497 | move=> H5. 498 | apply False_ind. 499 | apply H5. 500 | rewrite (proj2 H2 (fst k)). 501 | rewrite (proj2 H2 (snd k)). 502 | apply H1. 503 | move=> H4. 504 | apply False_ind. 505 | suff: (fst k = snd k). 506 | move=> H5. 507 | apply (lt_irrefl (proj1_sig (fst k))). 508 | rewrite {2} H5. 509 | apply H1. 510 | apply (BijInj {n : nat | n < N} {n : nat | n < N} ginv). 511 | exists (proj1_sig g). 512 | apply conj. 513 | apply (proj2 H2). 514 | apply (proj1 H2). 515 | apply sig_map. 516 | apply H4. 517 | apply H3. 518 | move=> H3. 519 | apply (Im_intro ({n : nat | n < N} * {n : nat | n < N}) ({n : nat | n < N} * {n : nat | n < N}) (fun (xy : {n : nat | n < N} * {n : nat | n < N}) => proj1_sig (fst xy) < proj1_sig (snd xy)) (fun (xy : {n : nat | n < N} * {n : nat | n < N}) => match excluded_middle_informative (proj1_sig (proj1_sig g (fst xy)) < proj1_sig (proj1_sig g (snd xy))) with 520 | | left _ => (proj1_sig g (fst xy), proj1_sig g (snd xy)) 521 | | right _ => (proj1_sig g (snd xy), proj1_sig g (fst xy)) 522 | end) (ginv (snd k), ginv (fst k))). 523 | apply H3. 524 | simpl. 525 | elim (excluded_middle_informative (proj1_sig (proj1_sig g (ginv (snd k))) < proj1_sig (proj1_sig g (ginv (fst k))))). 526 | move=> H4. 527 | apply False_ind. 528 | apply (lt_irrefl (proj1_sig (snd k))). 529 | apply (lt_trans (proj1_sig (snd k)) (proj1_sig (fst k)) (proj1_sig (snd k))). 530 | rewrite - (proj2 H2 (fst k)). 531 | rewrite - (proj2 H2 (snd k)). 532 | apply H4. 533 | apply H1. 534 | move=> H4. 535 | apply injective_projections. 536 | rewrite (proj2 H2 (fst k)). 537 | reflexivity. 538 | rewrite (proj2 H2 (snd k)). 539 | reflexivity. 540 | move=> xy. 541 | elim. 542 | move=> k H1 y. 543 | elim (excluded_middle_informative (proj1_sig (proj1_sig g (fst k)) < proj1_sig (proj1_sig g (snd k)))). 544 | move=> H2 H3. 545 | rewrite H3. 546 | apply H2. 547 | move=> H2 H3. 548 | rewrite H3. 549 | elim (le_or_lt (proj1_sig (proj1_sig g (snd k))) (proj1_sig (proj1_sig g (fst k)))). 550 | move=> H4. 551 | elim (le_lt_or_eq (proj1_sig (proj1_sig g (snd k))) (proj1_sig (proj1_sig g (fst k)))). 552 | apply. 553 | move=> H5. 554 | apply False_ind. 555 | apply (lt_irrefl (proj1_sig (snd k))). 556 | suff: (snd k = fst k). 557 | move=> H6. 558 | rewrite {1} H6. 559 | apply H1. 560 | apply (BijInj {n : nat | n < N} {n : nat | n < N} (proj1_sig g) (proj2_sig g)). 561 | apply sig_map. 562 | apply H5. 563 | apply H4. 564 | move=> H4. 565 | apply False_ind. 566 | apply (H2 H4). 567 | Qed. 568 | 569 | Lemma PermutationIDParity : forall (N : nat), PermutationParity N (PermutationID N) = OFF. 570 | Proof. 571 | move=> N. 572 | apply MySumF2O. 573 | move=> u H1. 574 | elim (excluded_middle_informative (proj1_sig (proj1_sig (PermutationID N) (fst u)) < proj1_sig (proj1_sig (PermutationID N) (snd u)))). 575 | move=> H2. 576 | reflexivity. 577 | move=> H2. 578 | apply False_ind. 579 | apply (H2 H1). 580 | Qed. 581 | 582 | Lemma PermutationInvParity : forall (N : nat) (f : Permutation N), PermutationParity N (PermutationInv N f) = PermutationParity N f. 583 | Proof. 584 | move=> N f. 585 | suff: (PermutationParity N (PermutationID N) = OFF). 586 | rewrite - (PermutationCompose_inv_l N f). 587 | rewrite (PermutationComposeParity N (PermutationInv N f) f). 588 | elim (PermutationParity N (PermutationInv N f)). 589 | elim (PermutationParity N f). 590 | move=> H1. 591 | reflexivity. 592 | apply. 593 | elim (PermutationParity N f). 594 | move=> H1. 595 | rewrite - H1. 596 | reflexivity. 597 | apply. 598 | apply (PermutationIDParity N). 599 | Qed. 600 | 601 | Lemma PermutationSwapParity : forall (N : nat) (x y : {n : nat | n < N}), x <> y -> PermutationParity N (PermutationSwap N x y) = ON. 602 | Proof. 603 | suff: (forall (N : nat) (x y : {n : nat | n < N}), proj1_sig x < proj1_sig y -> PermutationParity N (PermutationSwap N x y) = ON). 604 | move=> H1 N x y H2. 605 | elim (nat_total_order (proj1_sig x) (proj1_sig y)). 606 | apply (H1 N x y). 607 | rewrite (PermutationSwap_comm N x y). 608 | apply (H1 N y x). 609 | move=> H3. 610 | apply H2. 611 | apply sig_map. 612 | apply H3. 613 | move=> N x y H1. 614 | unfold PermutationParity. 615 | rewrite (MySumF2Excluded ({n : nat | n < N} * {n : nat | n < N}) ParityXORCM (fun (xy : {n : nat | n < N} * {n : nat | n < N}) => match excluded_middle_informative (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy)) < proj1_sig (proj1_sig (PermutationSwap N x y) (snd xy))) with 616 | | left _ => OFF 617 | | right _ => ON 618 | end) (exist (Finite ({n : nat | n < N} * {n : nat | n < N})) (fun xy : {n : nat | n < N} * {n : nat | n < N} => proj1_sig (fst xy) < proj1_sig (snd xy)) (PermutationParitySub N)) (fun xy : {n : nat | n < N} * {n : nat | n < N} => (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy)) > proj1_sig (proj1_sig (PermutationSwap N x y) (snd xy))))). 619 | rewrite (MySumF2O ({n : nat | n < N} * {n : nat | n < N}) (FiniteIntersection ({n : nat | n < N} * {n : nat | n < N}) (exist (Finite ({n : nat | n < N} * {n : nat | n < N})) (fun (xy : {n : nat | n < N} * {n : nat | n < N}) => proj1_sig (fst xy) < proj1_sig (snd xy)) (PermutationParitySub N)) (Complement ({n : nat | n < N} * {n : nat | n < N}) (fun (xy : {n : nat | n < N} * {n : nat | n < N}) => proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy)) > proj1_sig (proj1_sig (PermutationSwap N x y) (snd xy)))))). 620 | rewrite (CM_O_r ParityXORCM). 621 | suff: (Included ({n : nat | n < N} * {n : nat | n < N}) (proj1_sig (FiniteAdd ({n : nat | n < N} * {n : nat | n < N}) (FiniteUnion ({n : nat | n < N} * {n : nat | n < N}) (FiniteIm {n : nat | n < N} ({n : nat | n < N} * {n : nat | n < N}) (fun (k : {n : nat | n < N}) => (x, k)) (FiniteIntersection {n : nat | n < N} (exist (Finite {n : nat | n < N}) (Full_set {n : nat | n < N}) (CountFinite N)) (fun (k : {n : nat | n < N}) => proj1_sig x < proj1_sig k < proj1_sig y))) (FiniteIm {n : nat | n < N} ({n : nat | n < N} * {n : nat | n < N}) (fun (k : {n : nat | n < N}) => (k, y)) (FiniteIntersection {n : nat | n < N} (exist (Finite {n : nat | n < N}) (Full_set {n : nat | n < N}) (CountFinite N)) (fun (k : {n : nat | n < N}) => proj1_sig x < proj1_sig k < proj1_sig y))) ) (x, y))) (proj1_sig (FiniteIntersection ({n : nat | n < N} * {n : nat | n < N}) (exist (Finite ({n : nat | n < N} * {n : nat | n < N})) (fun xy : {n : nat | n < N} * {n : nat | n < N} => proj1_sig (fst xy) < proj1_sig (snd xy)) (PermutationParitySub N)) (fun xy : {n : nat | n < N} * {n : nat | n < N} => proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy)) > proj1_sig (proj1_sig (PermutationSwap N x y) (snd xy)))) )). 622 | move=> H2. 623 | suff: ((FiniteIntersection ({n : nat | n < N} * {n : nat | n < N}) (exist (Finite ({n : nat | n < N} * {n : nat | n < N})) (fun xy : {n : nat | n < N} * {n : nat | n < N} => proj1_sig (fst xy) < proj1_sig (snd xy)) (PermutationParitySub N)) (fun xy : {n : nat | n < N} * {n : nat | n < N} => proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy)) > proj1_sig (proj1_sig (PermutationSwap N x y) (snd xy)))) = (FiniteAdd ({n : nat | n < N} * {n : nat | n < N}) (FiniteUnion ({n : nat | n < N} * {n : nat | n < N}) (FiniteIm {n : nat | n < N} ({n : nat | n < N} * {n : nat | n < N}) (fun (k : {n : nat | n < N}) => (x, k)) (FiniteIntersection {n : nat | n < N} (exist (Finite {n : nat | n < N}) (Full_set {n : nat | n < N}) (CountFinite N)) (fun (k : {n : nat | n < N}) => proj1_sig x < proj1_sig k < proj1_sig y))) (FiniteIm {n : nat | n < N} ({n : nat | n < N} * {n : nat | n < N}) (fun (k : {n : nat | n < N}) => (k, y)) (FiniteIntersection {n : nat | n < N} (exist (Finite {n : nat | n < N}) (Full_set {n : nat | n < N}) (CountFinite N)) (fun (k : {n : nat | n < N}) => proj1_sig x < proj1_sig k < proj1_sig y))) ) (x, y))). 624 | move=> H3. 625 | rewrite H3. 626 | rewrite MySumF2Add. 627 | suff: ((MySumF2 ({n : nat | n < N} * {n : nat | n < N}) (FiniteUnion ({n : nat | n < N} * {n : nat | n < N}) (FiniteIm {n : nat | n < N} ({n : nat | n < N} * {n : nat | n < N}) (fun k : {n : nat | n < N} => (x, k)) (FiniteIntersection {n : nat | n < N} (exist (Finite {n : nat | n < N}) (Full_set {n : nat | n < N}) (CountFinite N)) (fun k : {n : nat | n < N} => proj1_sig x < proj1_sig k < proj1_sig y))) (FiniteIm {n : nat | n < N} ({n : nat | n < N} * {n : nat | n < N}) (fun k : {n : nat | n < N} => (k, y)) (FiniteIntersection {n : nat | n < N} (exist (Finite {n : nat | n < N}) (Full_set {n : nat | n < N}) (CountFinite N)) (fun k : {n : nat | n < N} => proj1_sig x < proj1_sig k < proj1_sig y)))) ParityXORCM (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy)) < proj1_sig (proj1_sig (PermutationSwap N x y) (snd xy))) with 628 | | left _ => OFF 629 | | right _ => ON 630 | end)) = OFF). 631 | move=> H4. 632 | rewrite H4. 633 | elim (H2 (x, y)). 634 | move=> xy H5 H6. 635 | elim (excluded_middle_informative (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy)) < proj1_sig (proj1_sig (PermutationSwap N x y) (snd xy)))). 636 | move=> H7. 637 | apply False_ind. 638 | apply (lt_irrefl (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy))) (lt_trans (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy))) (proj1_sig (proj1_sig (PermutationSwap N x y) (snd xy))) (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy))) H7 H5)). 639 | move=> H7. 640 | reflexivity. 641 | right. 642 | apply In_singleton. 643 | rewrite MySumF2Union. 644 | rewrite - (MySumF2BijectiveSame2 {n : nat | n < N} ({n : nat | n < N} * {n : nat | n < N}) (FiniteIntersection {n : nat | n < N} (exist (Finite {n : nat | n < N}) (Full_set {n : nat | n < N}) (CountFinite N)) (fun k : {n : nat | n < N} => proj1_sig x < proj1_sig k < proj1_sig y)) (fun (k : {n : nat | n < N}) => (x, k)) ParityXORCM (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy)) < proj1_sig (proj1_sig (PermutationSwap N x y) (snd xy))) with 645 | | left _ => OFF 646 | | right _ => ON 647 | end)). 648 | rewrite - (MySumF2BijectiveSame2 {n : nat | n < N} ({n : nat | n < N} * {n : nat | n < N}) (FiniteIntersection {n : nat | n < N} (exist (Finite {n : nat | n < N}) (Full_set {n : nat | n < N}) (CountFinite N)) (fun k : {n : nat | n < N} => proj1_sig x < proj1_sig k < proj1_sig y)) (fun (k : {n : nat | n < N}) => (k, y)) ParityXORCM (fun xy : {n : nat | n < N} * {n : nat | n < N} => match excluded_middle_informative (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy)) < proj1_sig (proj1_sig (PermutationSwap N x y) (snd xy))) with 649 | | left _ => OFF 650 | | right _ => ON 651 | end)). 652 | unfold compose. 653 | apply (FiniteSetInduction {n : nat | n < N} (FiniteIntersection {n : nat | n < N} (exist (Finite {n : nat | n < N}) (Full_set {n : nat | n < N}) (CountFinite N)) (fun k : {n : nat | n < N} => proj1_sig x < proj1_sig k < proj1_sig y))). 654 | apply conj. 655 | rewrite MySumF2Empty. 656 | rewrite MySumF2Empty. 657 | reflexivity. 658 | move=> B b H4 H5 H6 H7. 659 | rewrite MySumF2Add. 660 | rewrite MySumF2Add. 661 | elim (H2 (x, b)). 662 | move=> xy1 H8 H9. 663 | elim (excluded_middle_informative (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy1)) < proj1_sig (proj1_sig (PermutationSwap N x y) (snd xy1)))). 664 | move=> H10. 665 | apply False_ind. 666 | apply (lt_irrefl (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy1))) (lt_trans (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy1))) (proj1_sig (proj1_sig (PermutationSwap N x y) (snd xy1))) (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy1))) H10 H8)). 667 | move=> H10. 668 | elim (H2 (b, y)). 669 | move=> xy2 H11 H12. 670 | elim (excluded_middle_informative (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy2)) < proj1_sig (proj1_sig (PermutationSwap N x y) (snd xy2)))). 671 | move=> H13. 672 | apply False_ind. 673 | apply (lt_irrefl (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy2))) (lt_trans (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy2))) (proj1_sig (proj1_sig (PermutationSwap N x y) (snd xy2))) (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy2))) H13 H11)). 674 | move=> H13. 675 | simpl. 676 | rewrite (ParityXOR_comm (MySumF2 {n : nat | n < N} B ParityXORCM (fun k : {n : nat | n < N} => match excluded_middle_informative (proj1_sig (match excluded_middle_informative (k = x) with 677 | | left _ => y 678 | | right _ => match excluded_middle_informative (k = y) with 679 | | left _ => x 680 | | right _ => k 681 | end 682 | end) < proj1_sig (match excluded_middle_informative (y = x) with 683 | | left _ => y 684 | | right _ => match excluded_middle_informative (y = y) with 685 | | left _ => x 686 | | right _ => y 687 | end 688 | end)) with 689 | | left _ => OFF 690 | | right _ => ON 691 | end)) ON). 692 | rewrite - (ParityXOR_assoc (ParityXOR (MySumF2 {n : nat | n < N} B ParityXORCM (fun k : {n : nat | n < N} => match excluded_middle_informative (proj1_sig (match excluded_middle_informative (x = x) with 693 | | left _ => y 694 | | right _ => match excluded_middle_informative (x = y) with 695 | | left _ => x 696 | | right _ => x 697 | end 698 | end) < proj1_sig (match excluded_middle_informative (k = x) with 699 | | left _ => y 700 | | right _ => match excluded_middle_informative (k = y) with 701 | | left _ => x 702 | | right _ => k 703 | end 704 | end)) with 705 | | left _ => OFF 706 | | right _ => ON 707 | end)) ON) ON (MySumF2 {n : nat | n < N} B ParityXORCM (fun k : {n : nat | n < N} => match excluded_middle_informative (proj1_sig (match excluded_middle_informative (k = x) with 708 | | left _ => y 709 | | right _ => match excluded_middle_informative (k = y) with 710 | | left _ => x 711 | | right _ => k 712 | end 713 | end) < proj1_sig (match excluded_middle_informative (y = x) with 714 | | left _ => y 715 | | right _ => match excluded_middle_informative (y = y) with 716 | | left _ => x 717 | | right _ => y 718 | end 719 | end)) with 720 | | left _ => OFF 721 | | right _ => ON 722 | end))). 723 | rewrite (ParityXOR_assoc (MySumF2 {n : nat | n < N} B ParityXORCM (fun k : {n : nat | n < N} => match excluded_middle_informative (proj1_sig (match excluded_middle_informative (x = x) with 724 | | left _ => y 725 | | right _ => match excluded_middle_informative (x = y) with 726 | | left _ => x 727 | | right _ => x 728 | end 729 | end) < proj1_sig (match excluded_middle_informative (k = x) with 730 | | left _ => y 731 | | right _ => match excluded_middle_informative (k = y) with 732 | | left _ => x 733 | | right _ => k 734 | end 735 | end)) with 736 | | left _ => OFF 737 | | right _ => ON 738 | end)) ON ON). 739 | simpl. 740 | rewrite ParityXOR_O_r. 741 | apply H7. 742 | left. 743 | right. 744 | apply (Im_intro {n : nat | n < N} ({n : nat | n < N} * {n : nat | n < N}) (Intersection {n : nat | n < N} (fun (k : {n : nat | n < N}) => proj1_sig x < proj1_sig k < proj1_sig y) (Full_set {n : nat | n < N})) (fun (k : {n : nat | n < N}) => (k, y)) b H5). 745 | reflexivity. 746 | left. 747 | left. 748 | apply (Im_intro {n : nat | n < N} ({n : nat | n < N} * {n : nat | n < N}) (Intersection {n : nat | n < N} (fun (k : {n : nat | n < N}) => proj1_sig x < proj1_sig k < proj1_sig y) (Full_set {n : nat | n < N})) (fun (k : {n : nat | n < N}) => (x, k)) b H5). 749 | reflexivity. 750 | apply H6. 751 | apply H6. 752 | move=> u1 u2 H4 H5 H6. 753 | suff: (u1 = fst (u1, y)). 754 | move=> H7. 755 | rewrite H7. 756 | rewrite H6. 757 | reflexivity. 758 | reflexivity. 759 | move=> u1 u2 H4 H5 H6. 760 | suff: (u1 = snd (x, u1)). 761 | move=> H7. 762 | rewrite H7. 763 | rewrite H6. 764 | reflexivity. 765 | reflexivity. 766 | move=> u. 767 | elim. 768 | move=> k1 H4 z1 H5 H6. 769 | suff: (z1 = (k1, y)). 770 | elim H6. 771 | move=> k2 H7 z2 H9 H10. 772 | apply (lt_irrefl (proj1_sig (snd z2))). 773 | rewrite {1} H9. 774 | rewrite H10. 775 | elim H7. 776 | move=> l H11 H12. 777 | apply (proj2 H11). 778 | apply H5. 779 | move=> H4. 780 | suff: ((exists (k : {n : nat | n < N}), (proj1_sig x < proj1_sig k < proj1_sig y) /\ (x, k) = (x, y)) \/ (exists (k : {n : nat | n < N}), (proj1_sig x < proj1_sig k < proj1_sig y) /\ (k, y) = (x, y))). 781 | elim. 782 | elim. 783 | move=> k H5. 784 | apply (lt_irrefl (proj1_sig (snd (x, k)))). 785 | rewrite {2} (proj2 H5). 786 | apply (proj2 (proj1 H5)). 787 | elim. 788 | move=> k H5. 789 | apply (lt_irrefl (proj1_sig (fst (k, y)))). 790 | rewrite {1} (proj2 H5). 791 | apply (proj1 (proj1 H5)). 792 | elim H4. 793 | move=> xy. 794 | elim. 795 | move=> k H5 z H6. 796 | left. 797 | rewrite H6. 798 | exists k. 799 | apply conj. 800 | elim H5. 801 | move=> k0 H7 H8. 802 | apply H7. 803 | reflexivity. 804 | move=> xy. 805 | elim. 806 | move=> k H5 z H6. 807 | right. 808 | rewrite H6. 809 | exists k. 810 | apply conj. 811 | elim H5. 812 | move=> k0 H7 H8. 813 | apply H7. 814 | reflexivity. 815 | apply sig_map. 816 | apply Extensionality_Ensembles. 817 | apply conj. 818 | move=> xy. 819 | elim. 820 | move=> xy1. 821 | unfold In. 822 | unfold PermutationSwap. 823 | simpl. 824 | elim (excluded_middle_informative (fst xy1 = x)). 825 | elim (excluded_middle_informative (snd xy1 = x)). 826 | move=> H3 H4 H5. 827 | apply False_ind. 828 | apply (lt_irrefl (proj1_sig y) H5). 829 | elim (excluded_middle_informative (snd xy1 = y)). 830 | move=> H3 H4 H5 H6 H7. 831 | right. 832 | suff: (xy1 = (x, y)). 833 | move=> H8. 834 | rewrite H8. 835 | apply In_singleton. 836 | apply injective_projections. 837 | apply H5. 838 | apply H3. 839 | move=> H3 H4 H5 H6 H7. 840 | left. 841 | left. 842 | apply (Im_intro {n : nat | n < N} ({n : nat | n < N} * {n : nat | n < N}) (Intersection {n : nat | n < N} (fun k : {n : nat | n < N} => proj1_sig x < proj1_sig k < proj1_sig y) (Full_set {n : nat | n < N})) (fun k : {n : nat | n < N} => (x, k)) (snd xy1)). 843 | apply Intersection_intro. 844 | apply conj. 845 | rewrite - H5. 846 | apply H7. 847 | apply H6. 848 | apply Full_intro. 849 | apply injective_projections. 850 | apply H5. 851 | reflexivity. 852 | elim (excluded_middle_informative (fst xy1 = y)). 853 | elim (excluded_middle_informative (snd xy1 = x)). 854 | move=> H3 H4 H5 H6 H7. 855 | apply False_ind. 856 | apply (lt_irrefl (proj1_sig (fst xy1))). 857 | apply (lt_trans (proj1_sig (fst xy1)) (proj1_sig (snd xy1)) (proj1_sig (fst xy1)) H7). 858 | rewrite H3. 859 | rewrite H4. 860 | apply H1. 861 | elim (excluded_middle_informative (snd xy1 = y)). 862 | move=> H3 H4 H5 H6 H7. 863 | apply False_ind. 864 | apply (lt_irrefl (proj1_sig x) H7). 865 | move=> H3 H4 H5 H6 H7 H8. 866 | apply False_ind. 867 | apply (lt_irrefl (proj1_sig x)). 868 | apply (lt_trans (proj1_sig x) (proj1_sig (fst xy1)) (proj1_sig x)). 869 | rewrite H5. 870 | apply H1. 871 | apply (lt_trans (proj1_sig (fst xy1)) (proj1_sig (snd xy1)) (proj1_sig x) H8 H7). 872 | elim (excluded_middle_informative (snd xy1 = x)). 873 | move=> H3 H4 H5 H6 H7. 874 | apply False_ind. 875 | apply (lt_irrefl (proj1_sig y)). 876 | apply (lt_trans (proj1_sig y) (proj1_sig x) (proj1_sig y)). 877 | apply (lt_trans (proj1_sig y) (proj1_sig (fst xy1)) (proj1_sig x) H6). 878 | rewrite - H3. 879 | apply H7. 880 | apply H1. 881 | elim (excluded_middle_informative (snd xy1 = y)). 882 | move=> H3 H4 H5 H6 H7 H8. 883 | left. 884 | right. 885 | apply (Im_intro {n : nat | n < N} ({n : nat | n < N} * {n : nat | n < N}) (Intersection {n : nat | n < N} (fun k : {n : nat | n < N} => proj1_sig x < proj1_sig k < proj1_sig y) (Full_set {n : nat | n < N})) (fun k : {n : nat | n < N} => (k, y)) (fst xy1)). 886 | apply Intersection_intro. 887 | apply conj. 888 | apply H7. 889 | rewrite - H3. 890 | apply H8. 891 | apply Full_intro. 892 | apply injective_projections. 893 | reflexivity. 894 | apply H3. 895 | move=> H3 H4 H5 H6 H7 H8. 896 | apply False_ind. 897 | apply (lt_irrefl (proj1_sig (fst xy1)) (lt_trans (proj1_sig (fst xy1)) (proj1_sig (snd xy1)) (proj1_sig (fst xy1)) H8 H7)). 898 | apply H2. 899 | move=> xy. 900 | elim. 901 | move=> xy1. 902 | elim. 903 | move=> xy2. 904 | elim. 905 | move=> k H2 z H3. 906 | apply Intersection_intro. 907 | rewrite H3. 908 | unfold PermutationSwap. 909 | unfold In. 910 | simpl. 911 | elim (excluded_middle_informative (x = x)). 912 | elim (excluded_middle_informative (k = x)). 913 | move=> H4. 914 | apply False_ind. 915 | apply (lt_irrefl (proj1_sig k)). 916 | rewrite {1} H4. 917 | elim H2. 918 | move=> k1 H5 H6. 919 | apply (proj1 H5). 920 | elim (excluded_middle_informative (k = y)). 921 | move=> H4 H5 H6. 922 | apply H1. 923 | move=> H4 H5 H6. 924 | elim H2. 925 | move=> k1 H7 H8. 926 | apply (proj2 H7). 927 | move=> H4. 928 | apply False_ind. 929 | apply H4. 930 | reflexivity. 931 | rewrite H3. 932 | elim H2. 933 | move=> k1 H4 H5. 934 | apply (proj1 H4). 935 | move=> xy2. 936 | elim. 937 | move=> k H2 z H3. 938 | apply Intersection_intro. 939 | rewrite H3. 940 | unfold PermutationSwap. 941 | unfold In. 942 | simpl. 943 | elim (excluded_middle_informative (k = x)). 944 | move=> H4. 945 | apply False_ind. 946 | apply (lt_irrefl (proj1_sig k)). 947 | rewrite {1} H4. 948 | elim H2. 949 | move=> k1 H5 H6. 950 | apply (proj1 H5). 951 | elim (excluded_middle_informative (k = y)). 952 | move=> H4. 953 | apply False_ind. 954 | apply (lt_irrefl (proj1_sig k)). 955 | rewrite {2} H4. 956 | elim H2. 957 | move=> k1 H5 H6. 958 | apply (proj2 H5). 959 | elim (excluded_middle_informative (y = x)). 960 | move=> H4. 961 | apply False_ind. 962 | apply (lt_irrefl (proj1_sig y)). 963 | rewrite {1} H4. 964 | apply H1. 965 | elim (excluded_middle_informative (y = y)). 966 | move=> H4 H5 H6 H7. 967 | elim H2. 968 | move=> k1 H8 H9. 969 | apply (proj1 H8). 970 | move=> H4. 971 | apply False_ind. 972 | apply H4. 973 | reflexivity. 974 | rewrite H3. 975 | elim H2. 976 | move=> k1 H4 H5. 977 | apply (proj2 H4). 978 | move=> xy1. 979 | elim. 980 | apply Intersection_intro. 981 | unfold PermutationSwap. 982 | unfold In. 983 | simpl. 984 | elim (excluded_middle_informative (x = x)). 985 | elim (excluded_middle_informative (y = x)). 986 | move=> H2. 987 | apply False_ind. 988 | apply (lt_irrefl (proj1_sig y)). 989 | rewrite {1} H2. 990 | apply H1. 991 | elim (excluded_middle_informative (y = y)). 992 | move=> H2 H3 H4. 993 | apply H1. 994 | move=> H2. 995 | apply False_ind. 996 | apply H2. 997 | reflexivity. 998 | move=> H2. 999 | apply False_ind. 1000 | apply H2. 1001 | reflexivity. 1002 | apply H1. 1003 | move=> u. 1004 | elim. 1005 | move=> xy H2 H3. 1006 | elim (excluded_middle_informative (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy)) < proj1_sig (proj1_sig (PermutationSwap N x y) (snd xy)))). 1007 | move=> H4. 1008 | reflexivity. 1009 | move=> H4. 1010 | apply False_ind. 1011 | elim (nat_total_order (proj1_sig (proj1_sig (PermutationSwap N x y) (fst xy))) (proj1_sig (proj1_sig (PermutationSwap N x y) (snd xy)))). 1012 | apply H4. 1013 | apply H2. 1014 | move=> H5. 1015 | apply (lt_irrefl (proj1_sig (fst xy))). 1016 | suff: (fst xy = snd xy). 1017 | move=> H6. 1018 | rewrite {2} H6. 1019 | apply H3. 1020 | apply (BijInj {n : nat | n < N} {n : nat | n < N} (proj1_sig (PermutationSwap N x y)) (proj2_sig (PermutationSwap N x y)) (fst xy) (snd xy)). 1021 | apply sig_map. 1022 | apply H5. 1023 | Qed. 1024 | -------------------------------------------------------------------------------- /BasicProperty/MappingProperty.v: -------------------------------------------------------------------------------- 1 | From mathcomp Require Import ssreflect. 2 | Require Import Classical. 3 | Require Import Coq.Program.Basics. 4 | Require Import Coq.Logic.Description. 5 | Require Import Coq.Logic.ClassicalDescription. 6 | Require Import Coq.Logic.FunctionalExtensionality. 7 | Require Import Coq.Sets.Finite_sets_facts. 8 | Require Import Coq.Sets.Image. 9 | Require Import Coq.Arith.Plus. 10 | Require Import Coq.Arith.Minus. 11 | Require Import Coq.Arith.Mult. 12 | Require Import Coq.Arith.PeanoNat. 13 | Require Import Coq.Arith.Le. 14 | 15 | Definition Injective {A B : Type} (f : A -> B) := forall x y, f x = f y -> x = y. 16 | 17 | Definition Surjective {A B : Type} (f : A -> B) := forall y, exists x, f x = y. 18 | 19 | Definition Bijective {A B : Type} (f : A -> B) := exists (g : B -> A), (forall x, g (f x) = x) /\ (forall y, f (g y) = y). 20 | 21 | Lemma InjSurjBij : forall (A B : Type) (f : A -> B), Injective f -> Surjective f -> Bijective f. 22 | Proof. 23 | move=> A B f H1 H2. 24 | suff: (forall (b : B), {a : A | f a = b}). 25 | move=> H3. 26 | exists (fun (b : B) => proj1_sig (H3 b)). 27 | apply conj. 28 | move=> x. 29 | apply (H1 (proj1_sig (H3 (f x))) x). 30 | apply (proj2_sig (H3 (f x))). 31 | move=> y. 32 | apply (proj2_sig (H3 y)). 33 | move=> b. 34 | apply (constructive_definite_description (fun (a : A) => f a = b)). 35 | apply (proj1 (unique_existence (fun (a : A) => f a = b))). 36 | apply conj. 37 | apply (H2 b). 38 | move=> a1 a2 H3 H4. 39 | apply (H1 a1 a2). 40 | rewrite H4. 41 | apply H3. 42 | Qed. 43 | 44 | Lemma BijInj : forall (A B : Type) (f : A -> B), Bijective f -> Injective f. 45 | Proof. 46 | move=> A B f. 47 | elim. 48 | move=> g H1 a1 a2 H2. 49 | rewrite - (proj1 H1 a1). 50 | rewrite - (proj1 H1 a2). 51 | rewrite H2. 52 | reflexivity. 53 | Qed. 54 | 55 | Lemma BijSurj : forall (A B : Type) (f : A -> B), Bijective f -> Surjective f. 56 | Proof. 57 | move=> A B f. 58 | elim. 59 | move=> g H1 b. 60 | exists (g b). 61 | apply (proj2 H1 b). 62 | Qed. 63 | 64 | Lemma BijChain : forall (A B C : Type) (f : A -> B) (g : B -> C), Bijective f -> Bijective g -> Bijective (compose g f). 65 | Proof. 66 | move=> A B C f g. 67 | elim. 68 | move=> fi H1. 69 | elim. 70 | move=> gi H2. 71 | exists (fun (c : C) => fi (gi c)). 72 | apply conj. 73 | move=> a. 74 | rewrite (proj1 H2 (f a)). 75 | apply (proj1 H1 a). 76 | move=> c. 77 | unfold compose. 78 | rewrite (proj2 H1 (gi c)). 79 | apply (proj2 H2 c). 80 | Qed. 81 | 82 | Lemma SurjChain : forall (A B C : Type) (f : A -> B) (g : B -> C), Surjective f -> Surjective g -> Surjective (compose g f). 83 | Proof. 84 | move=> A B C f g H1 H2 c. 85 | elim (H2 c). 86 | move=> b H3. 87 | elim (H1 b). 88 | move=> a H4. 89 | exists a. 90 | unfold compose. 91 | rewrite H4. 92 | apply H3. 93 | Qed. 94 | 95 | Lemma InjChain : forall (A B C : Type) (f : A -> B) (g : B -> C), Injective f -> Injective g -> Injective (compose g f). 96 | Proof. 97 | move=> A B C f g H1 H2 a1 a2 H3. 98 | apply (H1 a1 a2). 99 | apply (H2 (f a1) (f a2) H3). 100 | Qed. 101 | 102 | Lemma ChainSurj : forall (A B C : Type) (f : A -> B) (g : B -> C), Surjective (compose g f) -> Surjective g. 103 | Proof. 104 | move=> A B C f g H1 c. 105 | elim (H1 c). 106 | move=> a H2. 107 | exists (f a). 108 | apply H2. 109 | Qed. 110 | 111 | Lemma ChainInj : forall (A B C : Type) (f : A -> B) (g : B -> C), Injective (compose g f) -> Injective f. 112 | Proof. 113 | move=> A B C f g H1 a1 a2 H2. 114 | apply (H1 a1 a2). 115 | unfold compose. 116 | rewrite H2. 117 | reflexivity. 118 | Qed. 119 | 120 | Lemma InvUnique : forall (A B : Type) (f : A -> B) (g1 g2 : B -> A), ((forall x, g1 (f x) = x) /\ (forall y, f (g1 y) = y)) -> ((forall x, g2 (f x) = x) /\ (forall y, f (g2 y) = y)) -> g1 = g2. 121 | Proof. 122 | move=> A B f g1 g2 H1 H2. 123 | apply functional_extensionality. 124 | move=> x. 125 | apply (BijInj A B f). 126 | exists g1. 127 | apply H1. 128 | rewrite (proj2 H2 x). 129 | apply (proj2 H1 x). 130 | Qed. 131 | 132 | Lemma BijectiveInvExist : forall (A B : Type) (f : A -> B), Bijective f -> {g : B -> A | (forall x, g (f x) = x) /\ (forall y, f (g y) = y)}. 133 | Proof. 134 | move=> A B f H1. 135 | apply constructive_definite_description. 136 | apply (proj1 (unique_existence (fun (g : B -> A) => (forall x, g (f x) = x) /\ (forall y, f (g y) = y)))). 137 | apply conj. 138 | elim H1. 139 | move=> g H2. 140 | exists g. 141 | apply H2. 142 | move=> g1 g2 H2 H3. 143 | apply (InvUnique A B f g1 g2 H2 H3). 144 | Qed. 145 | 146 | Lemma sig_map : forall {T : Type} (P : T -> Prop) (x : {x : T | P x}) (y : {x : T | P x}), proj1_sig x = proj1_sig y -> x = y. 147 | Proof. 148 | move=> A P x y. 149 | case x. 150 | move=> xv xp. 151 | case y. 152 | move=> yv yp . 153 | simpl. 154 | move=> H1. 155 | subst xv. 156 | rewrite (proof_irrelevance (P yv) yp xp). 157 | by []. 158 | Qed. 159 | 160 | Lemma CardinalSigSame : forall (T : Type) (A : Ensemble T) (n : nat), (cardinal T A n) <-> (cardinal {t : T | A t} (Full_set {t : T | A t}) n). 161 | Proof. 162 | suff: (forall (n : nat) (T : Type) (A : Ensemble T) (B : Ensemble T), cardinal T (Intersection T A B) n <-> cardinal {t : T | A t} (fun (x : {t : T | A t}) => B (proj1_sig x)) n). 163 | move=> H1 T A n. 164 | suff: (A = Intersection T A (Full_set T)). 165 | move=> H2. 166 | rewrite {1} H2. 167 | suff: ((Full_set {t : T | A t}) = (fun x : {t : T | A t} => (Full_set T) (proj1_sig x))). 168 | move=> H3. 169 | rewrite H3. 170 | apply (H1 n T A (Full_set T)). 171 | apply Extensionality_Ensembles. 172 | apply conj. 173 | move=> a H3. 174 | apply (Full_intro T (proj1_sig a)). 175 | move=> t H3. 176 | apply (Full_intro {t0 : T | A t0} t). 177 | apply Extensionality_Ensembles. 178 | apply conj. 179 | move=> a H2. 180 | apply (Intersection_intro T A (Full_set T) a H2 (Full_intro T a)). 181 | move=> a. 182 | elim. 183 | move=> a0 H2 H3. 184 | apply H2. 185 | elim. 186 | move=> T A B. 187 | apply conj. 188 | move=> H1. 189 | suff: ((fun x : {t : T | A t} => B (proj1_sig x)) = Empty_set {t : T | A t}). 190 | move=> H2. 191 | rewrite H2. 192 | apply (card_empty {t : T | A t}). 193 | apply Extensionality_Ensembles. 194 | apply conj. 195 | move=> t H2. 196 | apply False_ind. 197 | suff: (In T (Empty_set T) (proj1_sig t)). 198 | elim. 199 | rewrite - (cardinal_invert T (Intersection T A B) 0 H1). 200 | apply (Intersection_intro T A B (proj1_sig t)). 201 | apply (proj2_sig t). 202 | apply H2. 203 | move=> x. 204 | elim. 205 | move=> H1. 206 | suff: (Intersection T A B = Empty_set T). 207 | move=> H2. 208 | rewrite H2. 209 | apply (card_empty T). 210 | apply Extensionality_Ensembles. 211 | apply conj. 212 | move=> t. 213 | elim. 214 | move=> t0 H2 H3. 215 | apply False_ind. 216 | suff: (In {t : T | A t} (Empty_set {t : T | A t}) (exist A t0 H2)). 217 | elim. 218 | rewrite - (cardinal_elim {t : T | A t} (fun x : {t : T | A t} => B (proj1_sig x)) 0 H1). 219 | apply H3. 220 | move=> t. 221 | elim. 222 | move=> n H1 T A B. 223 | apply conj. 224 | move=> H2. 225 | elim (cardinal_invert T (Intersection T A B) (S n) H2). 226 | move=> B0. 227 | elim. 228 | move=> b H3. 229 | suff: (In T A b). 230 | move=> H4. 231 | suff: ((fun x : {t : T | A t} => B (proj1_sig x)) = Add {t : T | A t} (fun x : {t : T | A t} => (fun t : T => B t /\ t <> b) (proj1_sig x)) (exist A b H4)). 232 | move=> H5. 233 | rewrite H5. 234 | suff: (cardinal {t : T | A t} (fun x : {t : T | A t} => B (proj1_sig x) /\ proj1_sig x <> b) n). 235 | move=> H6. 236 | apply (card_add {t : T | A t} (fun x : {t : T | A t} => B (proj1_sig x) /\ proj1_sig x <> b) n H6 (exist A b H4)). 237 | move=> H7. 238 | apply (proj2 H7). 239 | reflexivity. 240 | apply (proj1 (H1 T A (fun t : T => B t /\ t <> b))). 241 | suff: (Intersection T A (fun t : T => B t /\ t <> b) = B0). 242 | move=> H6. 243 | rewrite H6. 244 | apply (proj2 (proj2 H3)). 245 | apply Extensionality_Ensembles. 246 | apply conj. 247 | move=> t. 248 | elim. 249 | move=> t0 H6 H7. 250 | suff: (In T (Intersection T A B) t0). 251 | rewrite (proj1 H3). 252 | move=> H8. 253 | suff: (t0 <> b). 254 | elim H8. 255 | move=> t1 H9 H10. 256 | apply H9. 257 | move=> t1. 258 | elim. 259 | move=> H9. 260 | apply False_ind. 261 | apply H9. 262 | reflexivity. 263 | apply (proj2 H7). 264 | apply (Intersection_intro T A B t0 H6 (proj1 H7)). 265 | move=> t H6. 266 | apply (Intersection_intro T A (fun t : T => B t /\ t <> b) t). 267 | suff: (In T (Intersection T A B) t). 268 | elim. 269 | move=> t0 H7 H8. 270 | apply H7. 271 | rewrite (proj1 H3). 272 | left. 273 | apply H6. 274 | apply conj. 275 | suff: (In T (Intersection T A B) t). 276 | elim. 277 | move=> t0 H7 H8. 278 | apply H8. 279 | rewrite (proj1 H3). 280 | left. 281 | apply H6. 282 | move=> H7. 283 | apply (proj1 (proj2 H3)). 284 | rewrite - H7. 285 | apply H6. 286 | apply Extensionality_Ensembles. 287 | apply conj. 288 | move=> t H5. 289 | elim (classic (proj1_sig t = b)). 290 | move=> H6. 291 | right. 292 | suff: (t = exist A b H4). 293 | move=> H7. 294 | rewrite H7. 295 | apply (In_singleton {t0 : T | A t0} (exist A b H4)). 296 | apply sig_map. 297 | apply H6. 298 | move=> H6. 299 | left. 300 | apply conj. 301 | apply H5. 302 | apply H6. 303 | move=> t. 304 | elim. 305 | move=> t0 H5. 306 | apply (proj1 H5). 307 | move=> t0 H5. 308 | unfold In. 309 | suff: (In T (Intersection T A B) (proj1_sig t0)). 310 | elim. 311 | move=> t1 H6 H7. 312 | apply H7. 313 | rewrite (proj1 H3). 314 | elim H5. 315 | right. 316 | apply (In_singleton T b). 317 | suff: (In T (Intersection T A B) b). 318 | elim. 319 | move=> t H4 H5. 320 | apply H4. 321 | rewrite (proj1 H3). 322 | right. 323 | apply (In_singleton T b). 324 | move=> H2. 325 | elim (cardinal_invert {t : T | A t} (fun x : {t : T | A t} => B (proj1_sig x)) (S n) H2). 326 | move=> B0. 327 | elim. 328 | move=> b H3. 329 | suff: (Intersection T A B = Add T (Intersection T A (fun (t : T) => exists (H : A t), B0 (exist A t H))) (proj1_sig b)). 330 | move=> H4. 331 | rewrite H4. 332 | suff: (cardinal T (Intersection T A (fun t : T => exists H : A t, B0 (exist A t H))) n). 333 | move=> H5. 334 | apply (card_add T (Intersection T A (fun t : T => exists H : A t, B0 (exist A t H))) n H5 (proj1_sig b)). 335 | move=> H6. 336 | suff: (forall (H : A (proj1_sig b)), ~ B0 (exist A (proj1_sig b) H)). 337 | elim H6. 338 | move=> t H7 H8 H9. 339 | elim H8. 340 | move=> H10 H11. 341 | apply (H9 H10 H11). 342 | move=> H7 H8. 343 | apply (proj1 (proj2 H3)). 344 | suff: (b = (exist A (proj1_sig b) H7)). 345 | move=> H9. 346 | rewrite H9. 347 | apply H8. 348 | apply sig_map. 349 | reflexivity. 350 | apply (proj2 (H1 T A (fun t : T => exists H : A t, B0 (exist A t H)))). 351 | suff: ((fun x : {t : T | A t} => exists H : A (proj1_sig x), B0 (exist A (proj1_sig x) H)) = B0). 352 | move=> H5. 353 | rewrite H5. 354 | apply (proj2 (proj2 H3)). 355 | apply Extensionality_Ensembles. 356 | apply conj. 357 | move=> t. 358 | elim. 359 | move=> H5 H6. 360 | suff: (t = (exist A (proj1_sig t) H5)). 361 | move=> H7. 362 | rewrite H7. 363 | apply H6. 364 | apply sig_map. 365 | reflexivity. 366 | move=> t H5. 367 | exists (proj2_sig t). 368 | suff: ((exist A (proj1_sig t) (proj2_sig t)) = t). 369 | move=> H6. 370 | rewrite H6. 371 | apply H5. 372 | apply sig_map. 373 | reflexivity. 374 | apply Extensionality_Ensembles. 375 | apply conj. 376 | move=> t H4. 377 | elim (classic (t = proj1_sig b)). 378 | move=> H5. 379 | right. 380 | rewrite H5. 381 | apply (In_singleton T (proj1_sig b)). 382 | move=> H5. 383 | left. 384 | suff: (t <> proj1_sig b). 385 | elim H4. 386 | move=> t0 H6 H7 H8. 387 | apply (Intersection_intro T A (fun t1 : T => exists H : A t1, B0 (exist A t1 H)) t0 H6). 388 | exists H6. 389 | suff: (~ In {t : T | A t} (Singleton {t : T | A t} b) (exist A t0 H6)). 390 | suff: (In {t : T | A t} (fun x : {t : T | A t} => B (proj1_sig x)) (exist A t0 H6)). 391 | rewrite (proj1 H3). 392 | elim. 393 | move=> t1 H9 H10. 394 | apply H9. 395 | move=> t1 H9 H10. 396 | apply False_ind. 397 | apply (H10 H9). 398 | apply H7. 399 | move=> H9. 400 | apply H8. 401 | suff: (exist A t0 H6 = b). 402 | move=> H10. 403 | rewrite - H10. 404 | reflexivity. 405 | elim H9. 406 | reflexivity. 407 | apply H5. 408 | move=> t. 409 | elim. 410 | move=> t0. 411 | elim. 412 | move=> t1 H4 H5. 413 | apply (Intersection_intro T A B t1 H4). 414 | elim H5. 415 | move=> H6 H7. 416 | suff: (In {t : T | A t} (fun x : {t : T | A t} => B (proj1_sig x)) (exist A t1 H6)). 417 | apply. 418 | rewrite (proj1 H3). 419 | left. 420 | apply H7. 421 | move=> t0. 422 | elim. 423 | apply (Intersection_intro T A B (proj1_sig b)). 424 | apply (proj2_sig b). 425 | suff: (In {t : T | A t} (fun x : {t : T | A t} => B (proj1_sig x)) b). 426 | apply. 427 | rewrite (proj1 H3). 428 | right. 429 | apply (In_singleton {t : T | A t} b). 430 | Qed. 431 | 432 | Lemma FiniteSigSame : forall (T : Type) (A : Ensemble T), (Finite T A) <-> (Finite {t : T | A t} (Full_set {t : T | A t})). 433 | Proof. 434 | move=> T A. 435 | apply conj. 436 | move=> H1. 437 | elim (finite_cardinal T A H1). 438 | move=> n H2. 439 | apply (cardinal_finite {t : T | A t} (Full_set {t : T | A t}) n). 440 | apply (proj1 (CardinalSigSame T A n) H2). 441 | move=> H1. 442 | elim (finite_cardinal {t : T | A t} (Full_set {t : T | A t}) H1). 443 | move=> n H2. 444 | apply (cardinal_finite T A n). 445 | apply (proj2 (CardinalSigSame T A n) H2). 446 | Qed. 447 | 448 | Lemma CountCardinalBijective : forall (T : Type) (N : nat), (exists (f : {n : nat | n < N} -> T), Bijective f) <-> cardinal T (Full_set T) N. 449 | Proof. 450 | move=> T N. 451 | apply conj. 452 | elim. 453 | move=> f H1. 454 | suff: (forall (k : nat), (k <= N) -> cardinal T (fun (t : T) => exists (m : {n : nat | n < N}), proj1_sig m < k /\ t = f m) k). 455 | move=> H2. 456 | suff: (Full_set T = (fun t : T => exists m : {n : nat | n < N}, proj1_sig m < N /\ t = f m)). 457 | move=> H3. 458 | rewrite H3. 459 | apply (H2 N (le_n N)). 460 | apply Extensionality_Ensembles. 461 | apply conj. 462 | move=> t H3. 463 | elim (BijSurj {n : nat | n < N} T f H1 t). 464 | move=> m H4. 465 | exists m. 466 | apply conj. 467 | apply (proj2_sig m). 468 | rewrite H4. 469 | reflexivity. 470 | move=> t H3. 471 | apply (Full_intro T t). 472 | elim. 473 | move=> H2. 474 | suff: ((fun t : T => exists m : {n : nat | n < N}, proj1_sig m < 0 /\ t = f m) = Empty_set T). 475 | move=> H3. 476 | rewrite H3. 477 | apply (card_empty T). 478 | apply Extensionality_Ensembles. 479 | apply conj. 480 | move=> t. 481 | elim. 482 | move=> m H3. 483 | apply False_ind. 484 | apply (le_not_lt O (proj1_sig m)). 485 | apply (le_0_n (proj1_sig m)). 486 | apply (proj1 H3). 487 | move=> t. 488 | elim. 489 | move=> k H2 H3. 490 | suff: ((fun t : T => exists m : {n : nat | n < N}, proj1_sig m < S k /\ t = f m) = Add T (fun t : T => exists m : {n : nat | n < N}, proj1_sig m < k /\ t = f m) (f (exist (fun n : nat => n < N) k H3))). 491 | move=> H4. 492 | rewrite H4. 493 | suff: (k <= N). 494 | move=> H5. 495 | apply (card_add T (fun t : T => exists m : {n : nat | n < N}, proj1_sig m < k /\ t = f m) k (H2 H5) (f (exist (fun n : nat => n < N) k H3))). 496 | elim. 497 | move=> m H6. 498 | apply (le_not_lt k k (le_n k)). 499 | suff: (k = proj1_sig (exist (fun n : nat => n < N) k H3)). 500 | move=> H7. 501 | rewrite {1} H7. 502 | suff: ((exist (fun n : nat => n < N) k H3) = m). 503 | move=> H8. 504 | rewrite H8. 505 | apply (proj1 H6). 506 | apply (BijInj {n : nat | n < N} T f H1 (exist (fun n : nat => n < N) k H3) m). 507 | apply (proj2 H6). 508 | reflexivity. 509 | apply (le_trans k (S k) N (le_S k k (le_n k)) H3). 510 | apply Extensionality_Ensembles. 511 | apply conj. 512 | move=> t. 513 | elim. 514 | move=> m H4. 515 | elim (le_lt_or_eq (proj1_sig m) k). 516 | move=> H5. 517 | left. 518 | exists m. 519 | apply conj. 520 | apply H5. 521 | apply (proj2 H4). 522 | move=> H5. 523 | right. 524 | suff: ((exist (fun n : nat => n < N) k H3) = m). 525 | move=> H6. 526 | rewrite H6. 527 | rewrite (proj2 H4). 528 | apply (In_singleton T (f m)). 529 | apply sig_map. 530 | rewrite H5. 531 | reflexivity. 532 | apply (le_S_n (proj1_sig m) k (proj1 H4)). 533 | move=> t. 534 | elim. 535 | move=> t0. 536 | elim. 537 | move=> m H4. 538 | exists m. 539 | apply conj. 540 | apply (le_S (S (proj1_sig m)) k (proj1 H4)). 541 | apply (proj2 H4). 542 | move=> t0. 543 | elim. 544 | exists (exist (fun n : nat => n < N) k H3). 545 | apply conj. 546 | apply (le_n (S k)). 547 | reflexivity. 548 | move=> H1. 549 | suff: (forall (m : nat) (A : Ensemble T), cardinal T A m -> exists f : {n : nat | n < m} -> {t : T | A t}, Bijective f). 550 | move=> H2. 551 | elim (H2 N (Full_set T) H1). 552 | move=> f H3. 553 | exists (fun m : {n : nat | n < N} => proj1_sig (f m)). 554 | apply (BijChain {n : nat | n < N} {t : T | Full_set T t} T f). 555 | apply H3. 556 | exists (fun t : T => (exist (Full_set T) t (Full_intro T t))). 557 | apply conj. 558 | move=> t0. 559 | apply sig_map. 560 | reflexivity. 561 | move=> y. 562 | reflexivity. 563 | elim. 564 | move=> A H2. 565 | rewrite (cardinal_elim T A 0 H2). 566 | suff: (forall (n : nat), n < 0 -> False). 567 | move=> H3. 568 | exists (fun m : {n : nat | n < 0} => match (H3 (proj1_sig m) (proj2_sig m)) with 569 | end). 570 | exists (fun t0 : {t : T | Empty_set T t} => match (proj2_sig t0) with 571 | end). 572 | apply conj. 573 | move=> m. 574 | apply False_ind. 575 | apply (H3 (proj1_sig m) (proj2_sig m)). 576 | move=> t0. 577 | elim (proj2_sig t0). 578 | move=> n. 579 | apply (le_not_lt 0 n (le_0_n n)). 580 | move=> k H2 A H3. 581 | elim (cardinal_invert T A (S k) H3). 582 | move=> A0. 583 | elim. 584 | move=> a H4. 585 | elim (H2 A0 (proj2 (proj2 H4))). 586 | move=> f H5. 587 | suff: (In T A a). 588 | move=> H6. 589 | suff: (forall (a0 : T), In T A0 a0 -> In T A a0). 590 | move=> H7. 591 | exists (fun m : {n : nat | n < S k} => match excluded_middle_informative (proj1_sig m < k) with 592 | | left H => exist A (proj1_sig (f (exist (fun n : nat => n < k) (proj1_sig m) H))) (H7 (proj1_sig (f (exist (fun n : nat => n < k) (proj1_sig m) H))) (proj2_sig (f (exist (fun n : nat => n < k) (proj1_sig m) H)))) 593 | | right _ => exist A a H6 594 | end). 595 | apply InjSurjBij. 596 | move=> m1 m2. 597 | elim (excluded_middle_informative (proj1_sig m1 < k)). 598 | move=> H8. 599 | elim (excluded_middle_informative (proj1_sig m2 < k)). 600 | move=> H9 H10. 601 | apply sig_map. 602 | suff: ((exist (fun n : nat => n < k) (proj1_sig m1) H8) = (exist (fun n : nat => n < k) (proj1_sig m2) H9)). 603 | move=> H11. 604 | suff: (proj1_sig m1 = proj1_sig (exist (fun n : nat => n < k) (proj1_sig m1) H8)). 605 | move=> H12. 606 | rewrite H12. 607 | rewrite H11. 608 | reflexivity. 609 | reflexivity. 610 | suff: (f (exist (fun n : nat => n < k) (proj1_sig m1) H8) = f (exist (fun n : nat => n < k) (proj1_sig m2) H9)). 611 | move=> H11. 612 | elim H5. 613 | move=> g H12. 614 | rewrite - (proj1 H12 (exist (fun n : nat => n < k) (proj1_sig m1) H8)). 615 | rewrite H11. 616 | apply (proj1 H12 (exist (fun n : nat => n < k) (proj1_sig m2) H9)). 617 | apply sig_map. 618 | suff: (proj1_sig (f (exist (fun n : nat => n < k) (proj1_sig m1) H8)) = proj1_sig (exist A (proj1_sig (f (exist (fun n : nat => n < k) (proj1_sig m1) H8))) (H7 (proj1_sig (f (exist (fun n : nat => n < k) (proj1_sig m1) H8))) (proj2_sig (f (exist (fun n : nat => n < k) (proj1_sig m1) H8)))))). 619 | move=> H11. 620 | rewrite H11. 621 | rewrite H10. 622 | reflexivity. 623 | reflexivity. 624 | move=> H9 H10. 625 | apply False_ind. 626 | apply (proj1 (proj2 H4)). 627 | suff: (In T A0 (proj1_sig (exist A a H6))). 628 | apply. 629 | rewrite - H10. 630 | simpl. 631 | apply (proj2_sig (f (exist (fun n : nat => n < k) (proj1_sig m1) H8))). 632 | move=> H8. 633 | elim (excluded_middle_informative (proj1_sig m2 < k)). 634 | move=> H9 H10. 635 | apply False_ind. 636 | apply (proj1 (proj2 H4)). 637 | suff: (In T A0 (proj1_sig (exist A a H6))). 638 | apply. 639 | rewrite H10. 640 | simpl. 641 | apply (proj2_sig (f (exist (fun n : nat => n < k) (proj1_sig m2) H9))). 642 | move=> H9 H10. 643 | apply sig_map. 644 | elim (le_lt_or_eq (proj1_sig m1) k). 645 | move=> H11. 646 | elim (H8 H11). 647 | move=> H11. 648 | elim (le_lt_or_eq (proj1_sig m2) k). 649 | move=> H12. 650 | elim (H9 H12). 651 | move=> H12. 652 | rewrite H12. 653 | apply H11. 654 | apply (le_S_n (proj1_sig m2) k (proj2_sig m2)). 655 | apply (le_S_n (proj1_sig m1) k (proj2_sig m1)). 656 | move=> a0. 657 | suff: (In T (Add T A0 a) (proj1_sig a0)). 658 | move=> H8. 659 | suff: (exists m : {n : nat | n < S k}, proj1_sig match excluded_middle_informative (proj1_sig m < k) with 660 | | left H => exist A (proj1_sig (f (exist (fun n : nat => n < k) (proj1_sig m) H))) (H7 (proj1_sig (f (exist (fun n : nat => n < k) (proj1_sig m) H))) (proj2_sig (f (exist (fun n : nat => n < k) (proj1_sig m) H)))) 661 | | right _ => exist A a H6 662 | end = proj1_sig a0). 663 | elim. 664 | move=> m H9. 665 | exists m. 666 | apply sig_map. 667 | apply H9. 668 | elim H8. 669 | move=> t H9. 670 | elim H5. 671 | move=> g H10. 672 | suff: (forall (n : nat), n < k -> n < S k). 673 | move=> H11. 674 | exists (exist (fun n : nat => n < S k) (proj1_sig (g (exist A0 t H9))) (H11 (proj1_sig (g (exist A0 t H9))) (proj2_sig (g (exist A0 t H9))))). 675 | elim (excluded_middle_informative (proj1_sig (exist (fun n : nat => n < S k) (proj1_sig (g (exist A0 t H9))) (H11 (proj1_sig (g (exist A0 t H9))) (proj2_sig (g (exist A0 t H9))))) < k)). 676 | simpl. 677 | move=> H12. 678 | suff: ((exist (fun n : nat => n < k) (proj1_sig (g (exist A0 t H9))) H12) = (g (exist A0 t H9))). 679 | move=> H13. 680 | rewrite H13. 681 | rewrite (proj2 H10 (exist A0 t H9)). 682 | reflexivity. 683 | apply sig_map. 684 | reflexivity. 685 | move=> H12. 686 | apply False_ind. 687 | apply H12. 688 | simpl. 689 | apply (proj2_sig (g (exist A0 t H9))). 690 | move=> n H11. 691 | apply (le_S (S n) k H11). 692 | move=> t. 693 | elim. 694 | exists (exist (fun m : nat => m < S k) k (le_n (S k))). 695 | elim (excluded_middle_informative (proj1_sig (exist (fun m : nat => m < S k) k (le_n (S k))) < k)). 696 | simpl. 697 | move=> H9. 698 | apply False_ind. 699 | apply (le_not_lt k k (le_n k) H9). 700 | move=> H9. 701 | reflexivity. 702 | rewrite - (proj1 H4). 703 | apply (proj2_sig a0). 704 | move=> a0 H7. 705 | rewrite (proj1 H4). 706 | left. 707 | apply H7. 708 | rewrite (proj1 H4). 709 | right. 710 | apply (In_singleton T a). 711 | Qed. 712 | 713 | Lemma CountFiniteBijective : forall (T : Type), (exists (N : nat) (f : {n : nat | n < N} -> T), Bijective f) <-> Finite T (Full_set T). 714 | Proof. 715 | move=> T. 716 | apply conj. 717 | elim. 718 | move=> N. 719 | elim. 720 | move=> f H1. 721 | apply (cardinal_finite T (Full_set T) N). 722 | apply (proj1 (CountCardinalBijective T N)). 723 | exists f. 724 | apply H1. 725 | move=> H1. 726 | elim (finite_cardinal T (Full_set T) H1). 727 | move=> N H2. 728 | exists N. 729 | apply (proj2 (CountCardinalBijective T N) H2). 730 | Qed. 731 | 732 | Lemma CountCardinalSurjective : forall (T : Type) (N : nat) (f : {n : nat | n < N} -> T), Surjective f -> exists (M : nat), M <= N /\ cardinal T (Full_set T) M. 733 | Proof. 734 | move=> T N f H1. 735 | suff: (forall (k : nat), k <= N -> exists (M : nat), M <= k /\ cardinal T (Im {n : nat | n < N} T (fun m : {n : nat | n < N} => proj1_sig m < k) f) M). 736 | move=> H2. 737 | suff: (Full_set T = Im {n : nat | n < N} T (fun m : {n : nat | n < N} => proj1_sig m < N) f). 738 | move=> H3. 739 | rewrite H3. 740 | apply (H2 N (le_n N)). 741 | apply Extensionality_Ensembles. 742 | apply conj. 743 | move=> t H3. 744 | elim (H1 t). 745 | move=> m0 H4. 746 | apply (Im_intro {n : nat | n < N} T (fun m : {n : nat | n < N} => proj1_sig m < N) f m0). 747 | apply (proj2_sig m0). 748 | rewrite H4. 749 | reflexivity. 750 | move=> t H3. 751 | apply (Full_intro T t). 752 | elim. 753 | move=> H2. 754 | exists O. 755 | apply conj. 756 | apply (le_n O). 757 | suff: (Im {n : nat | n < N} T (fun m : {n : nat | n < N} => proj1_sig m < 0) f = Empty_set T). 758 | move=> H3. 759 | rewrite H3. 760 | apply (card_empty T). 761 | apply Extensionality_Ensembles. 762 | apply conj. 763 | move=> t. 764 | elim. 765 | move=> m H3. 766 | apply False_ind. 767 | apply (le_not_lt O (proj1_sig m) (le_0_n (proj1_sig m)) H3). 768 | move=> t. 769 | elim. 770 | move=> k H2 H3. 771 | elim (H2 (le_trans k (S k) N (le_S k k (le_n k)) H3)). 772 | move=> M H4. 773 | elim (classic (In T (Im {n : nat | n < N} T (fun m : {n : nat | n < N} => proj1_sig m < k) f) (f (exist (fun n : nat => n < N) k H3)))). 774 | move=> H5. 775 | exists M. 776 | apply conj. 777 | apply (le_S M k (proj1 H4)). 778 | suff: (Im {n : nat | n < N} T (fun m : {n : nat | n < N} => proj1_sig m < S k) f = (Im {n : nat | n < N} T (fun m : {n : nat | n < N} => proj1_sig m < k) f)). 779 | move=> H6. 780 | rewrite H6. 781 | apply (proj2 H4). 782 | apply Extensionality_Ensembles. 783 | apply conj. 784 | move=> t. 785 | elim. 786 | move=> m H6 y H7. 787 | rewrite H7. 788 | elim (le_lt_or_eq (S (proj1_sig m)) (S k) H6). 789 | move=> H8. 790 | apply (Im_intro {n : nat | n < N} T (fun m : {n : nat | n < N} => proj1_sig m < k) f m). 791 | apply (lt_S_n (proj1_sig m) k H8). 792 | reflexivity. 793 | move=> H8. 794 | suff: (m = (exist (fun n : nat => n < N) k H3)). 795 | move=> H9. 796 | rewrite H9. 797 | apply H5. 798 | apply sig_map. 799 | apply (eq_add_S (proj1_sig m) k H8). 800 | move=> t. 801 | elim. 802 | move=> m H6 y H7. 803 | apply (Im_intro {n : nat | n < N} T (fun m : {n : nat | n < N} => proj1_sig m < S k) f m). 804 | apply (le_S (S (proj1_sig m)) k H6). 805 | apply H7. 806 | move=> H5. 807 | exists (S M). 808 | apply conj. 809 | apply (le_n_S M k (proj1 H4)). 810 | suff: (Im {n : nat | n < N} T (fun m : {n : nat | n < N} => proj1_sig m < S k) f = Add T (Im {n : nat | n < N} T (fun m : {n : nat | n < N} => proj1_sig m < k) f) (f (exist (fun n : nat => n < N) k H3))). 811 | move=> H6. 812 | rewrite H6. 813 | apply (card_add T (Im {n : nat | n < N} T (fun m : {n : nat | n < N} => proj1_sig m < k) f) M (proj2 H4) (f (exist (fun n : nat => n < N) k H3))). 814 | apply H5. 815 | apply Extensionality_Ensembles. 816 | apply conj. 817 | move=> t. 818 | elim. 819 | move=> m H6 y H7. 820 | elim (le_lt_or_eq (S (proj1_sig m)) (S k) H6). 821 | move=> H8. 822 | left. 823 | apply (Im_intro {n : nat | n < N} T (fun m : {n : nat | n < N} => proj1_sig m < k) f m). 824 | apply (lt_S_n (proj1_sig m) k H8). 825 | apply H7. 826 | move=> H8. 827 | right. 828 | rewrite H7. 829 | suff: ((exist (fun n : nat => n < N) k H3) = m). 830 | move=> H9. 831 | rewrite H9. 832 | apply (In_singleton T (f m)). 833 | apply sig_map. 834 | apply (eq_add_S k (proj1_sig m)). 835 | rewrite H8. 836 | reflexivity. 837 | move=> t. 838 | elim. 839 | move=> t0. 840 | elim. 841 | move=> m H6 y H7. 842 | apply (Im_intro {n : nat | n < N} T (fun m : {n : nat | n < N} => proj1_sig m < S k) f m). 843 | apply (le_S (S (proj1_sig m)) k H6). 844 | apply H7. 845 | move=> t0. 846 | elim. 847 | apply (Im_intro {n : nat | n < N} T (fun m : {n : nat | n < N} => proj1_sig m < S k) f (exist (fun n : nat => n < N) k H3)). 848 | apply (le_n (S k)). 849 | reflexivity. 850 | Qed. 851 | 852 | Lemma CountFiniteSurjective : forall (T : Type) (N : nat) (f : {n : nat | n < N} -> T), Surjective f -> Finite T (Full_set T). 853 | Proof. 854 | move=> T N f H1. 855 | elim (CountCardinalSurjective T N f H1). 856 | move=> n H2. 857 | apply (cardinal_finite T (Full_set T) n (proj2 H2)). 858 | Qed. 859 | 860 | Lemma CountCardinalInjective : forall (T : Type) (N : nat) (f : T -> {n : nat | n < N}), Injective f -> exists (M : nat), M <= N /\ cardinal T (Full_set T) M. 861 | Proof. 862 | move=> T N f H1. 863 | suff: (forall (k : nat), k <= N -> exists (M : nat), M <= k /\ cardinal T (fun t : T => proj1_sig (f t) < k) M). 864 | move=> H2. 865 | suff: (Full_set T = (fun t : T => proj1_sig (f t) < N)). 866 | move=> H3. 867 | rewrite H3. 868 | apply (H2 N (le_n N)). 869 | apply Extensionality_Ensembles. 870 | apply conj. 871 | move=> t H3. 872 | apply (proj2_sig (f t)). 873 | move=> t H3. 874 | apply (Full_intro T t). 875 | elim. 876 | move=> H2. 877 | exists O. 878 | apply conj. 879 | apply (le_n O). 880 | suff: ((fun t : T => proj1_sig (f t) < 0) = Empty_set T). 881 | move=> H3. 882 | rewrite H3. 883 | apply (card_empty T). 884 | apply Extensionality_Ensembles. 885 | apply conj. 886 | move=> t H3. 887 | apply False_ind. 888 | apply (le_not_lt O (proj1_sig (f t)) (le_0_n (proj1_sig (f t))) H3). 889 | move=> t. 890 | elim. 891 | move=> k H2 H3. 892 | elim (H2 (le_trans k (S k) N (le_S k k (le_n k)) H3)). 893 | move=> M H4. 894 | elim (classic (Inhabited T (fun t : T => proj1_sig (f t) = k))). 895 | elim. 896 | move=> t H5. 897 | exists (S M). 898 | apply conj. 899 | apply (le_n_S M k (proj1 H4)). 900 | suff: ((fun t0 : T => proj1_sig (f t0) < S k) = Add T (fun t : T => proj1_sig (f t) < k) t). 901 | move=> H6. 902 | rewrite H6. 903 | apply (card_add T (fun t : T => proj1_sig (f t) < k) M (proj2 H4) t). 904 | move=> H7. 905 | apply (lt_not_le (proj1_sig (f t)) k H7). 906 | rewrite H5. 907 | apply (le_n k). 908 | apply Extensionality_Ensembles. 909 | apply conj. 910 | move=> t0 H6. 911 | elim (le_lt_or_eq (S (proj1_sig (f t0))) (S k) H6). 912 | move=> H7. 913 | left. 914 | apply (lt_S_n (proj1_sig (f t0)) k H7). 915 | move=> H7. 916 | right. 917 | suff: (t0 = t). 918 | move=> H8. 919 | rewrite H8. 920 | apply (In_singleton T t). 921 | apply (H1 t0 t). 922 | apply sig_map. 923 | rewrite H5. 924 | apply (eq_add_S (proj1_sig (f t0)) k H7). 925 | move=> t0. 926 | elim. 927 | move=> t1 H6. 928 | apply (le_S (S (proj1_sig (f t1))) k H6). 929 | move=> t1. 930 | elim. 931 | unfold In. 932 | rewrite H5. 933 | apply (le_n (S k)). 934 | move=> H5. 935 | exists M. 936 | apply conj. 937 | apply (le_S M k (proj1 H4)). 938 | suff: ((fun t : T => proj1_sig (f t) < S k) = (fun t : T => proj1_sig (f t) < k)). 939 | move=> H6. 940 | rewrite H6. 941 | apply (proj2 H4). 942 | apply Extensionality_Ensembles. 943 | apply conj. 944 | move=> t H6. 945 | elim (le_lt_or_eq (S (proj1_sig (f t))) (S k) H6). 946 | move=> H7. 947 | apply (lt_S_n (proj1_sig (f t)) k H7). 948 | move=> H7. 949 | apply False_ind. 950 | apply H5. 951 | apply (Inhabited_intro T (fun t : T => proj1_sig (f t) = k) t). 952 | apply (eq_add_S (proj1_sig (f t)) k H7). 953 | move=> t. 954 | apply (le_S (S (proj1_sig (f t))) k). 955 | Qed. 956 | 957 | Lemma CountFiniteInjective : forall (T : Type) (N : nat) (f : T -> {n : nat | n < N}), Injective f -> Finite T (Full_set T). 958 | Proof. 959 | move=> T N f H1. 960 | elim (CountCardinalInjective T N f H1). 961 | move=> n H2. 962 | apply (cardinal_finite T (Full_set T) n (proj2 H2)). 963 | Qed. 964 | 965 | Lemma CountInjectiveLe : forall (N M : nat) (f : {n : nat | n < N} -> {n : nat | n < M}), Injective f -> N <= M. 966 | Proof. 967 | move=> N M f H1. 968 | elim (CountCardinalInjective {n : nat | n < N} M f H1). 969 | move=> K H2. 970 | suff: (N = K). 971 | move=> H3. 972 | rewrite H3. 973 | apply (proj1 H2). 974 | rewrite (cardinal_is_functional {n : nat | n < N} (Full_set {n : nat | n < N}) K (proj2 H2) (Full_set {n : nat | n < N}) N). 975 | reflexivity. 976 | apply (proj1 (CountCardinalBijective {n : nat | n < N} N)). 977 | exists (fun (m : {n : nat | n < N}) => m). 978 | exists (fun (m : {n : nat | n < N}) => m). 979 | apply conj. 980 | move=> x. 981 | reflexivity. 982 | move=> y. 983 | reflexivity. 984 | reflexivity. 985 | Qed. 986 | 987 | Lemma BijectiveSigFull : forall (T : Type) (A : Ensemble T), (forall (t : T), In T A t) -> {f : T -> {t : T | In T A t} | (forall (t : T), t = proj1_sig (f t)) /\ Bijective f}. 988 | Proof. 989 | move=> T A H1. 990 | exists (fun (t : T) => exist A t (H1 t)). 991 | apply conj. 992 | move=> t. 993 | reflexivity. 994 | exists (fun (t0 : {t : T | In T A t}) => proj1_sig t0). 995 | apply conj. 996 | move=> x. 997 | reflexivity. 998 | move=> y. 999 | apply sig_map. 1000 | reflexivity. 1001 | Qed. 1002 | 1003 | Lemma BijectiveSigFullInv : forall (T : Type) (A : Ensemble T), (forall (t : T), In T A t) -> {f : {t : T | In T A t} -> T | (forall (t0 : {t : T | In T A t}), proj1_sig t0 = f t0) /\ Bijective f}. 1004 | Proof. 1005 | move=> T A H1. 1006 | exists (fun (t0 : {t : T | In T A t}) => proj1_sig t0). 1007 | apply conj. 1008 | move=> t0. 1009 | reflexivity. 1010 | exists (fun (t : T) => exist A t (H1 t)). 1011 | apply conj. 1012 | move=> x. 1013 | apply sig_map. 1014 | reflexivity. 1015 | move=> y. 1016 | reflexivity. 1017 | Qed. 1018 | 1019 | Lemma BijectiveSameSig : forall (T : Type) (A B : Ensemble T), A = B -> {f : {t : T | In T A t} -> {t : T | In T B t} | (forall (t0 : {t : T | In T A t}), proj1_sig t0 = proj1_sig (f t0)) /\ Bijective f}. 1020 | Proof. 1021 | move=> T A B H1. 1022 | rewrite H1. 1023 | exists (fun (t0 : {t : T | In T B t}) => t0). 1024 | apply conj. 1025 | move=> t0. 1026 | reflexivity. 1027 | exists (fun (t0 : {t : T | In T B t}) => t0). 1028 | apply conj. 1029 | move=> x. 1030 | reflexivity. 1031 | move=> y. 1032 | reflexivity. 1033 | Qed. 1034 | 1035 | Lemma BijectiveSigSig : forall (T : Type) (A B : Ensemble T), {f : {t : T | In T (Intersection T A B) t} -> {t0 : {t : T | In T A t} | In T B (proj1_sig t0)} | (forall (t0 : {t : T | In T (Intersection T A B) t}), proj1_sig t0 = proj1_sig (proj1_sig (f t0))) /\ Bijective f}. 1036 | Proof. 1037 | move=> T A B. 1038 | suff: (forall (t0 : {t : T | In T (Intersection T A B) t}), In T A (proj1_sig t0)). 1039 | move=> H1. 1040 | suff: (forall (t0 : {t : T | In T (Intersection T A B) t}), In T B (proj1_sig t0)). 1041 | move=> H2. 1042 | exists (fun (t0 : {t : T | In T (Intersection T A B) t}) => exist (fun (a : {t : T | In T A t}) => In T B (proj1_sig a)) (exist A (proj1_sig t0) (H1 t0)) (H2 t0)). 1043 | apply conj. 1044 | move=> t0. 1045 | reflexivity. 1046 | suff: (forall (x : {t0 : {t : T | In T A t} | In T B (proj1_sig t0)}),In T (Intersection T A B) (proj1_sig (proj1_sig x))). 1047 | move=> H3. 1048 | exists (fun (x : {t0 : {t : T | In T A t} | In T B (proj1_sig t0)}) => exist (Intersection T A B) (proj1_sig (proj1_sig x)) (H3 x)). 1049 | apply conj. 1050 | move=> x. 1051 | apply sig_map. 1052 | reflexivity. 1053 | move=> y. 1054 | apply sig_map. 1055 | apply sig_map. 1056 | reflexivity. 1057 | move=> x. 1058 | apply (Intersection_intro T A B (proj1_sig (proj1_sig x))). 1059 | apply (proj2_sig (proj1_sig x)). 1060 | apply (proj2_sig x). 1061 | move=> t0. 1062 | elim (proj2_sig t0). 1063 | move=> x H2 H3. 1064 | apply H3. 1065 | move=> t0. 1066 | elim (proj2_sig t0). 1067 | move=> x H2 H3. 1068 | apply H2. 1069 | Qed. 1070 | 1071 | Lemma BijectiveSigSigInv : forall (T : Type) (A B : Ensemble T), {f : {t0 : {t : T | In T A t} | In T B (proj1_sig t0)} -> {t : T | In T (Intersection T A B) t} | (forall (x : {t0 : {t : T | In T A t} | In T B (proj1_sig t0)}), proj1_sig (proj1_sig x) = proj1_sig (f x)) /\ Bijective f}. 1072 | Proof. 1073 | move=> T A B. 1074 | suff: (forall (x : {t0 : {t : T | In T A t} | In T B (proj1_sig t0)}),In T (Intersection T A B) (proj1_sig (proj1_sig x))). 1075 | move=> H1. 1076 | exists (fun (x : {t0 : {t : T | In T A t} | In T B (proj1_sig t0)}) => exist (Intersection T A B) (proj1_sig (proj1_sig x)) (H1 x)). 1077 | apply conj. 1078 | move=> x. 1079 | reflexivity. 1080 | suff: (forall (t0 : {t : T | In T (Intersection T A B) t}), In T A (proj1_sig t0)). 1081 | move=> H2. 1082 | suff: (forall (t0 : {t : T | In T (Intersection T A B) t}), In T B (proj1_sig t0)). 1083 | move=> H3. 1084 | exists (fun (t0 : {t : T | In T (Intersection T A B) t}) => exist (fun (a : {t : T | In T A t}) => In T B (proj1_sig a)) (exist A (proj1_sig t0) (H2 t0)) (H3 t0)). 1085 | apply conj. 1086 | move=> x. 1087 | apply sig_map. 1088 | apply sig_map. 1089 | reflexivity. 1090 | move=> y. 1091 | apply sig_map. 1092 | reflexivity. 1093 | move=> t0. 1094 | elim (proj2_sig t0). 1095 | move=> x H3 H4. 1096 | apply H4. 1097 | move=> t0. 1098 | elim (proj2_sig t0). 1099 | move=> x H3 H4. 1100 | apply H3. 1101 | move=> x. 1102 | apply (Intersection_intro T A B (proj1_sig (proj1_sig x))). 1103 | apply (proj2_sig (proj1_sig x)). 1104 | apply (proj2_sig x). 1105 | Qed. 1106 | 1107 | Lemma ForallSavesBijective_dep : forall (T : Type) (A : T -> Type) (B : T -> Type) (F : forall (t : T), (A t) -> (B t)), (forall (t : T), Bijective (F t)) -> Bijective (fun (x : forall (t : T), (A t)) (t0 : T) => (F t0 (x t0))). 1108 | Proof. 1109 | move=> T A B F H1. 1110 | suff: (forall (t : T), {g : (B t) -> (A t) | (forall (x : A t), g ((F t) x) = x) /\ (forall (y : B t), (F t) (g y) = y)}). 1111 | move=> H2. 1112 | exists (fun (y : forall (t : T), B t) (t0 : T) => proj1_sig (H2 t0) (y t0)). 1113 | apply conj. 1114 | move=> x. 1115 | apply functional_extensionality_dep. 1116 | move=> t. 1117 | apply (proj1 (proj2_sig (H2 t)) (x t)). 1118 | move=> y. 1119 | apply functional_extensionality_dep. 1120 | move=> t. 1121 | apply (proj2 (proj2_sig (H2 t)) (y t)). 1122 | move=> t. 1123 | apply constructive_definite_description. 1124 | apply (proj1 (unique_existence (fun (g : B t -> A t) => (forall (x : A t), g (F t x) = x) /\ (forall y : B t, F t (g y) = y)))). 1125 | apply conj. 1126 | elim (H1 t). 1127 | move=> g H2. 1128 | exists g. 1129 | apply H2. 1130 | move=> g1 g2 H2 H3. 1131 | apply functional_extensionality_dep. 1132 | move=> y. 1133 | rewrite - {1} (proj2 H3 y). 1134 | apply (proj1 H2 (g2 y)). 1135 | Qed. 1136 | 1137 | Lemma ForallSavesBijective : forall (T A B: Type) (F : T -> A -> B), (forall (t : T), Bijective (F t)) -> Bijective (fun (x : T -> A) (t0 : T) => (F t0 (x t0))). 1138 | Proof. 1139 | move=> T A B F. 1140 | apply (ForallSavesBijective_dep T (fun (t : T) => A) (fun (t : T) => B) F). 1141 | Qed. 1142 | 1143 | Lemma ForallSavesInjective_dep : forall (T : Type) (A : T -> Type) (B : T -> Type) (F : forall (t : T), (A t) -> (B t)), (forall (t : T), Injective (F t)) -> Injective (fun (x : forall (t : T), (A t)) (t0 : T) => (F t0 (x t0))). 1144 | Proof. 1145 | move=> T A B F H1 x1 x2 H2. 1146 | apply functional_extensionality_dep. 1147 | move=> t. 1148 | apply (H1 t (x1 t) (x2 t)). 1149 | suff: (F t (x1 t) = let temp := (fun t0 : T => F t0 (x1 t0)) in temp t). 1150 | move=> H3. 1151 | rewrite H3. 1152 | rewrite H2. 1153 | reflexivity. 1154 | reflexivity. 1155 | Qed. 1156 | 1157 | Lemma ForallSavesInjective : forall (T A B: Type) (F : T -> A -> B), (forall (t : T), Injective (F t)) -> Injective (fun (x : T -> A) (t0 : T) => (F t0 (x t0))). 1158 | Proof. 1159 | move=> T A B F. 1160 | apply (ForallSavesInjective_dep T (fun (t : T) => A) (fun (t : T) => B) F). 1161 | Qed. 1162 | 1163 | Definition Single := exist (fun (n : nat) => (n < 1)) O (le_n 1). 1164 | 1165 | Lemma SingleSame : forall (v : {n : nat | n < 1}), v = Single. 1166 | Proof. 1167 | move=> v. 1168 | apply sig_map. 1169 | rewrite (le_antisym (proj1_sig Single) 0 (le_S_n (proj1_sig Single) 0 (proj2_sig Single)) (le_0_n (proj1_sig Single))). 1170 | apply (le_antisym (proj1_sig v) 0 (le_S_n (proj1_sig v) 0 (proj2_sig v)) (le_0_n (proj1_sig v))). 1171 | Qed. 1172 | 1173 | Lemma CountReverseSig : forall (N : nat), {f : {n : nat | n < N} -> {n : nat | n < N} | forall (m : {n : nat | n < N}), S (proj1_sig m + proj1_sig (f m)) = N}. 1174 | Proof. 1175 | move=> N. 1176 | suff: (forall (k : {n : nat | n < N}), N - S (proj1_sig k) < N). 1177 | move=> H1. 1178 | exists (fun (m : {n : nat | n < N}) => (exist (fun (k : nat) => k < N) (N - S (proj1_sig m)) (H1 m))). 1179 | move=> m. 1180 | simpl. 1181 | apply (le_plus_minus_r (S (proj1_sig m)) N (proj2_sig m)). 1182 | move=> k. 1183 | apply (plus_lt_reg_l (N - S (proj1_sig k)) N (S (proj1_sig k))). 1184 | rewrite (le_plus_minus_r (S (proj1_sig k)) N (proj2_sig k)). 1185 | apply (le_n_S N (proj1_sig k + N)). 1186 | apply (le_plus_r (proj1_sig k) N). 1187 | Qed. 1188 | 1189 | Definition CountReverse (N : nat) := proj1_sig (CountReverseSig N). 1190 | 1191 | Definition CountReverseNature (N : nat) : (forall (m : {n : nat | n < N}), S (proj1_sig m + proj1_sig (CountReverse N m)) = N) := proj2_sig (CountReverseSig N). 1192 | 1193 | Lemma CountReverseInvolutive : forall (N : nat) (m : {n : nat | n < N}), CountReverse N (CountReverse N m) = m. 1194 | Proof. 1195 | move=> N m. 1196 | apply sig_map. 1197 | apply (plus_reg_l (proj1_sig (CountReverse N (CountReverse N m))) (proj1_sig m) (proj1_sig (CountReverse N m))). 1198 | apply eq_add_S. 1199 | rewrite (plus_comm (proj1_sig (CountReverse N m)) (proj1_sig m)). 1200 | rewrite (CountReverseNature N m). 1201 | apply (CountReverseNature N (CountReverse N m)). 1202 | Qed. 1203 | 1204 | Lemma AddConnectSig : forall (N M : nat), {f : {n : nat | n < N} + {n : nat | n < M} -> {n : nat | n < N + M} | (forall (m : {n : nat | n < N}), proj1_sig m = proj1_sig (f (inl m))) /\ (forall (m : {n : nat | n < M}), N + proj1_sig m = proj1_sig (f (inr m)))}. 1205 | Proof. 1206 | move=> N M. 1207 | suff: (forall (m : {n : nat | n < N}), proj1_sig m < N + M). 1208 | move=> H1. 1209 | suff: (forall (m : {n : nat | n < M}), N + proj1_sig m < N + M). 1210 | move=> H2. 1211 | exists (fun (m : {n : nat | n < N} + {n : nat | n < M}) => match m with 1212 | | inl k => exist (fun (l : nat) => l < N + M) (proj1_sig k) (H1 k) 1213 | | inr k => exist (fun (l : nat) => l < N + M) (N + proj1_sig k) (H2 k) 1214 | end). 1215 | apply conj. 1216 | move=> m. 1217 | reflexivity. 1218 | move=> m. 1219 | reflexivity. 1220 | move=> m. 1221 | apply (plus_lt_compat_l (proj1_sig m) M N (proj2_sig m)). 1222 | move=> m. 1223 | apply (le_trans (S (proj1_sig m)) N (N + M) (proj2_sig m) (le_plus_l N M)). 1224 | Qed. 1225 | 1226 | Definition AddConnect (N M : nat) := proj1_sig (AddConnectSig N M). 1227 | 1228 | Definition AddConnectNature (N M : nat) : (forall (m : {n : nat | n < N}), proj1_sig m = proj1_sig (AddConnect N M (inl m))) /\ (forall (m : {n : nat | n < M}), N + proj1_sig m = proj1_sig (AddConnect N M (inr m))) := proj2_sig (AddConnectSig N M). 1229 | 1230 | Lemma AddConnectInvSig : forall (N M : nat), {f : {n : nat | n < N + M} -> {n : nat | n < N} + {n : nat | n < M} | (forall (m : {n : nat | n < N + M}), (proj1_sig m < N) -> match (f m) with 1231 | | inl k => proj1_sig m = proj1_sig k 1232 | | inr _ => False 1233 | end) /\ (forall (m : {n : nat | n < N + M}), (N <= proj1_sig m) -> match (f m) with 1234 | | inl _ => False 1235 | | inr k => proj1_sig m = N + proj1_sig k 1236 | end)}. 1237 | Proof. 1238 | move=> N M. 1239 | suff: (forall (m : {n : nat | n < N + M}), ~ proj1_sig m < N -> proj1_sig m - N < M). 1240 | move=> H1. 1241 | exists (fun (m : {n : nat | n < N + M}) => match excluded_middle_informative (proj1_sig m < N) with 1242 | | left H => inl (exist (fun (k : nat) => k < N) (proj1_sig m) H) 1243 | | right H => inr (exist (fun (k : nat) => k < M) (proj1_sig m - N) (H1 m H)) 1244 | end). 1245 | apply conj. 1246 | move=> m H2. 1247 | elim (excluded_middle_informative (proj1_sig m < N)). 1248 | move=> H3. 1249 | reflexivity. 1250 | move=> H3. 1251 | apply (H3 H2). 1252 | move=> m H2. 1253 | elim (excluded_middle_informative (proj1_sig m < N)). 1254 | move=> H3. 1255 | apply (le_not_lt N (proj1_sig m) H2 H3). 1256 | move=> H3. 1257 | apply (le_plus_minus N (proj1_sig m) H2). 1258 | move=> m H1. 1259 | apply (plus_lt_reg_l (proj1_sig m - N) M N). 1260 | rewrite (le_plus_minus_r N (proj1_sig m)). 1261 | apply (proj2_sig m). 1262 | elim (le_or_lt N (proj1_sig m)). 1263 | apply. 1264 | move=> H2. 1265 | apply False_ind. 1266 | apply (H1 H2). 1267 | Qed. 1268 | 1269 | Definition AddConnectInv (N M : nat) := proj1_sig (AddConnectInvSig N M). 1270 | 1271 | Definition AddConnectInvNature (N M : nat) : (forall (m : {n : nat | n < N + M}), proj1_sig m < N -> match AddConnectInv N M m with 1272 | | inl k => proj1_sig m = proj1_sig k 1273 | | inr _ => False 1274 | end) /\ (forall (m : {n : nat | n < N + M}), N <= proj1_sig m -> match AddConnectInv N M m with 1275 | | inl _ => False 1276 | | inr k => proj1_sig m = N + proj1_sig k 1277 | end) := proj2_sig (AddConnectInvSig N M). 1278 | 1279 | Lemma AddConnectInvRelation : forall (N M : nat), (forall (m : {n : nat | n < N} + {n : nat | n < M}), AddConnectInv N M (AddConnect N M m) = m) /\ (forall (m : {n : nat | n < N + M}), AddConnect N M (AddConnectInv N M m) = m). 1280 | Proof. 1281 | move=> N M. 1282 | apply conj. 1283 | elim. 1284 | move=> m. 1285 | suff: (match AddConnectInv N M (AddConnect N M (inl m)) return Prop with 1286 | | inl k => proj1_sig (AddConnect N M (inl m)) = proj1_sig k 1287 | | inr _ => False 1288 | end). 1289 | elim (AddConnectInv N M (AddConnect N M (inl m))). 1290 | move=> k H1. 1291 | suff: (k = m). 1292 | move=> H2. 1293 | rewrite H2. 1294 | reflexivity. 1295 | apply sig_map. 1296 | rewrite - H1. 1297 | rewrite (proj1 (AddConnectNature N M) m). 1298 | reflexivity. 1299 | move=> k. 1300 | elim. 1301 | apply (proj1 (AddConnectInvNature N M) (AddConnect N M (inl m))). 1302 | rewrite - (proj1 (AddConnectNature N M) m). 1303 | apply (proj2_sig m). 1304 | move=> m. 1305 | suff: (match AddConnectInv N M (AddConnect N M (inr m)) return Prop with 1306 | | inl _ => False 1307 | | inr k => proj1_sig (AddConnect N M (inr m)) = N + proj1_sig k 1308 | end). 1309 | elim (AddConnectInv N M (AddConnect N M (inr m))). 1310 | move=> k. 1311 | elim. 1312 | move=> k H1. 1313 | suff: (m = k). 1314 | move=> H2. 1315 | rewrite H2. 1316 | reflexivity. 1317 | apply sig_map. 1318 | apply (plus_reg_l (proj1_sig m) (proj1_sig k) N). 1319 | rewrite (proj2 (AddConnectNature N M) m). 1320 | apply H1. 1321 | apply (proj2 (AddConnectInvNature N M) (AddConnect N M (inr m))). 1322 | rewrite - (proj2 (AddConnectNature N M) m). 1323 | apply (le_plus_l N (proj1_sig m)). 1324 | move=> m. 1325 | elim (le_or_lt N (proj1_sig m)). 1326 | move=> H1. 1327 | suff: (match AddConnectInv N M m return Prop with 1328 | | inl _ => False 1329 | | inr k => proj1_sig m = N + proj1_sig k 1330 | end). 1331 | elim (AddConnectInv N M m). 1332 | move=> k. 1333 | elim. 1334 | move=> k H2. 1335 | apply sig_map. 1336 | rewrite H2. 1337 | rewrite (proj2 (AddConnectNature N M) k). 1338 | reflexivity. 1339 | apply (proj2 (AddConnectInvNature N M) m). 1340 | apply H1. 1341 | move=> H1. 1342 | suff: (match AddConnectInv N M m return Prop with 1343 | | inl k => proj1_sig m = proj1_sig k 1344 | | inr _ => False 1345 | end). 1346 | elim (AddConnectInv N M m). 1347 | move=> k H2. 1348 | apply sig_map. 1349 | rewrite H2. 1350 | rewrite (proj1 (AddConnectNature N M) k). 1351 | reflexivity. 1352 | move=> k. 1353 | elim. 1354 | apply (proj1 (AddConnectInvNature N M) m). 1355 | apply H1. 1356 | Qed. 1357 | 1358 | Lemma CountAdd : forall (N M : nat), {f : {n : nat | n < N} + {n : nat | n < M} -> {n : nat | n < N + M} | Bijective f}. 1359 | Proof. 1360 | move=> N M. 1361 | exists (AddConnect N M). 1362 | exists (AddConnectInv N M). 1363 | apply (AddConnectInvRelation N M). 1364 | Qed. 1365 | 1366 | Lemma MultConnectSig : forall (N M : nat), {f : {n : nat | n < N} * {n : nat | n < M} -> {n : nat | n < N * M} | forall (m : {n : nat | n < N} * {n : nat | n < M}), proj1_sig (f m) = proj1_sig (fst m) * M + proj1_sig (snd m)}. 1367 | Proof. 1368 | elim. 1369 | move=> M. 1370 | exists (fun (xy : {n : nat | n < 0} * {n : nat | n < M}) => match (PeanoNat.Nat.nlt_0_r (proj1_sig (fst xy)) (proj2_sig (fst xy))) with 1371 | end). 1372 | move=> m. 1373 | elim (PeanoNat.Nat.nlt_0_r (proj1_sig (fst m)) (proj2_sig (fst m))). 1374 | move=> N H1 M. 1375 | exists (compose (AddConnect M (N * M)) (fun (m : {n : nat | n < S N} * {n : nat | n < M}) => match AddConnectInv 1 N (fst m) with 1376 | | inl _ => inl (snd m) 1377 | | inr a => inr (proj1_sig (H1 M) (a, snd m)) 1378 | end)). 1379 | move=> m. 1380 | unfold compose. 1381 | rewrite - {2} (proj2 (AddConnectInvRelation 1 N) (fst m)). 1382 | elim (AddConnectInv 1 N (fst m)). 1383 | move=> a. 1384 | rewrite - (proj1 (AddConnectNature 1 N) a). 1385 | rewrite (SingleSame a). 1386 | rewrite - (proj1 (AddConnectNature M (N * M)) (snd m)). 1387 | reflexivity. 1388 | move=> b. 1389 | rewrite - (proj2 (AddConnectNature M (N * M))). 1390 | rewrite - (proj2 (AddConnectNature 1 N)). 1391 | rewrite (proj2_sig (H1 M)). 1392 | simpl. 1393 | apply plus_assoc. 1394 | Qed. 1395 | 1396 | Definition MultConnect (N M : nat) := proj1_sig (MultConnectSig N M). 1397 | 1398 | Definition MultConnectNature (N M : nat) : forall (m : {n : nat | n < N} * {n : nat | n < M}), proj1_sig (MultConnect N M m) = proj1_sig (fst m) * M + proj1_sig (snd m) := proj2_sig (MultConnectSig N M). 1399 | 1400 | Lemma MultConnectInvSig : forall (N M : nat), {f : {n : nat | n < N * M} -> {n : nat | n < N} * {n : nat | n < M} | forall (m : {n : nat | n < N * M}), proj1_sig m = proj1_sig (fst (f m)) * M + proj1_sig (snd (f m))}. 1401 | Proof. 1402 | elim. 1403 | move=> M. 1404 | rewrite (mult_0_l M). 1405 | exists (fun (x : {n : nat | n < 0}) => match (PeanoNat.Nat.nlt_0_r (proj1_sig x) (proj2_sig x)) with 1406 | end). 1407 | move=> x. 1408 | elim (PeanoNat.Nat.nlt_0_r (proj1_sig x) (proj2_sig x)). 1409 | move=> N H1 M. 1410 | exists (compose (fun (m : {n : nat | n < M} + {n : nat | n < N * M}) => match m with 1411 | | inl a => (AddConnect 1 N (inl Single), a) 1412 | | inr b => (AddConnect 1 N (inr (fst (proj1_sig (H1 M) b))), snd (proj1_sig (H1 M) b)) 1413 | end) (AddConnectInv M (N * M))). 1414 | move=> m. 1415 | unfold compose. 1416 | rewrite - {1} (proj2 (AddConnectInvRelation M (N * M)) m). 1417 | elim (AddConnectInv M (N * M) m). 1418 | move=> a. 1419 | simpl. 1420 | rewrite - (proj1 (AddConnectNature M (N * M)) a). 1421 | rewrite - (proj1 (AddConnectNature 1 N) Single). 1422 | reflexivity. 1423 | move=> b. 1424 | simpl. 1425 | rewrite - (proj2 (AddConnectNature M (N * M)) b). 1426 | rewrite - (proj2 (AddConnectNature 1 N)). 1427 | rewrite (proj2_sig (H1 M) b). 1428 | rewrite plus_assoc. 1429 | reflexivity. 1430 | Qed. 1431 | 1432 | Definition MultConnectInv (N M : nat) := proj1_sig (MultConnectInvSig N M). 1433 | 1434 | Definition MultConnectInvNature (N M : nat) : forall (m : {n : nat | n < N * M}), proj1_sig m = proj1_sig (fst (MultConnectInv N M m)) * M + proj1_sig (snd (MultConnectInv N M m)) := proj2_sig (MultConnectInvSig N M). 1435 | 1436 | Lemma MultConnectInvRelation : forall (N M : nat), (forall (m : {n : nat | n < N} * {n : nat | n < M}), MultConnectInv N M (MultConnect N M m) = m) /\ (forall (m : {n : nat | n < N * M}), MultConnect N M (MultConnectInv N M m) = m). 1437 | Proof. 1438 | suff: (forall (N M : nat) (a b : {n : nat | n < N} * {n : nat | n < M}), proj1_sig (fst a) * M + proj1_sig (snd a) = proj1_sig (fst b) * M + proj1_sig (snd b) -> a = b). 1439 | move=> H1 N M. 1440 | apply conj. 1441 | move=> m. 1442 | apply (H1 N M). 1443 | rewrite - (MultConnectInvNature N M). 1444 | apply (MultConnectNature N M m). 1445 | move=> m. 1446 | apply sig_map. 1447 | rewrite (MultConnectNature N M). 1448 | rewrite (MultConnectInvNature N M). 1449 | reflexivity. 1450 | suff: (forall (N M : nat) (a b : {n : nat | n < N} * {n : nat | n < M}), proj1_sig (fst a) * M + proj1_sig (snd a) = proj1_sig (fst b) * M + proj1_sig (snd b) -> proj1_sig (fst a) <= proj1_sig (fst b)). 1451 | move=> H1 N M a b H2. 1452 | suff: (fst a = fst b). 1453 | move=> H3. 1454 | apply injective_projections. 1455 | apply H3. 1456 | apply sig_map. 1457 | apply (plus_reg_l (proj1_sig (snd a)) (proj1_sig (snd b)) (proj1_sig (fst a) * M)). 1458 | rewrite {2} H3. 1459 | apply H2. 1460 | apply sig_map. 1461 | apply le_antisym. 1462 | apply (H1 N M a b H2). 1463 | apply (H1 N M b a). 1464 | rewrite H2. 1465 | reflexivity. 1466 | move=> N M a b H1. 1467 | elim (le_or_lt (proj1_sig (fst a)) (proj1_sig (fst b))). 1468 | apply. 1469 | move=> H2. 1470 | elim (lt_irrefl (proj1_sig (fst a) * M + proj1_sig (snd a))). 1471 | rewrite {1} H1. 1472 | apply (le_trans (S (proj1_sig (fst b) * M + proj1_sig (snd b))) (proj1_sig (fst a) * M)). 1473 | apply (le_trans (S (proj1_sig (fst b) * M + proj1_sig (snd b))) ((S (proj1_sig (fst b))) * M)). 1474 | simpl. 1475 | rewrite (plus_comm (proj1_sig (fst b) * M) (proj1_sig (snd b))). 1476 | apply (plus_le_compat_r (S (proj1_sig (snd b))) M). 1477 | apply (proj2_sig (snd b)). 1478 | apply (mult_le_compat_r (S (proj1_sig (fst b))) (proj1_sig (fst a)) M H2). 1479 | apply le_plus_l. 1480 | Qed. 1481 | 1482 | Lemma CountMult : forall (N M : nat), {f : {n : nat | n < N} * {n : nat | n < M} -> {n : nat | n < N * M} | Bijective f}. 1483 | Proof. 1484 | move=> N M. 1485 | exists (MultConnect N M). 1486 | exists (MultConnectInv N M). 1487 | apply (MultConnectInvRelation N M). 1488 | Qed. 1489 | 1490 | Lemma CountPow : forall (N M : nat), {f : ({n : nat | n < N} -> {n : nat | n < M}) -> {n : nat | n < M ^ N} | Bijective f}. 1491 | Proof. 1492 | move=> N M. 1493 | elim N. 1494 | simpl. 1495 | exists (fun (_ : {n : nat | n < 0} -> {n : nat | n < M}) => exist (fun (n : nat) => n < S O) O (le_n (S O))). 1496 | exists (fun (m : {n : nat | n < S O}) (k : {n : nat | n < O}) => match (PeanoNat.Nat.nlt_0_r (proj1_sig k) (proj2_sig k)) with 1497 | end). 1498 | apply conj. 1499 | move=> x. 1500 | apply functional_extensionality. 1501 | move=> k. 1502 | apply False_ind. 1503 | apply (PeanoNat.Nat.nlt_0_r (proj1_sig k) (proj2_sig k)). 1504 | move=> y. 1505 | apply sig_map. 1506 | simpl. 1507 | elim (le_lt_or_eq (proj1_sig y) O). 1508 | move=> H1. 1509 | apply False_ind. 1510 | apply (PeanoNat.Nat.nlt_0_r (proj1_sig y) H1). 1511 | move=> H1. 1512 | rewrite H1. 1513 | reflexivity. 1514 | apply (le_S_n (proj1_sig y) O (proj2_sig y)). 1515 | move=> K. 1516 | elim. 1517 | move=> f1 H1. 1518 | simpl. 1519 | suff: ({f : ({n : nat | n < S K} -> {n : nat | n < M}) -> ({n : nat | n < M} * {n : nat | n < M ^ K}) | Bijective f}). 1520 | elim. 1521 | move=> f2 H2. 1522 | exists (compose (proj1_sig (CountMult M (M ^ K))) f2). 1523 | apply BijChain. 1524 | apply H2. 1525 | apply (proj2_sig (CountMult M (M ^ K))). 1526 | exists (fun (x : {n : nat | n < S K} -> {n : nat | n < M}) => (x (exist (fun (n : nat) => n < S K) K (le_n (S K))), f1 (fun (m : {n : nat | n < K}) => x (exist (fun (n : nat) => n < S K) (proj1_sig m) (le_trans (S (proj1_sig m)) K (S K) (proj2_sig m) (le_S K K (le_n K))))))). 1527 | elim H1. 1528 | move=> g1 H2. 1529 | exists (fun (x : {n : nat | n < M} * {n : nat | n < M ^ K}) (k : {n : nat | n < S K}) => match excluded_middle_informative (proj1_sig k < K) with 1530 | | left H => g1 (snd x) (exist (fun (n : nat) => n < K) (proj1_sig k) H) 1531 | | right H => fst x 1532 | end). 1533 | apply conj. 1534 | move=> x. 1535 | apply functional_extensionality. 1536 | move=> k. 1537 | elim (excluded_middle_informative (proj1_sig k < K)). 1538 | move=> H3. 1539 | simpl. 1540 | rewrite (proj1 H2 (fun m : {n : nat | n < K} => x (exist (fun n : nat => n < S K) (proj1_sig m) (Nat.le_trans (S (proj1_sig m)) K (S K) (proj2_sig m) (le_S K K (le_n K)))))). 1541 | suff: ((exist (fun n : nat => n < S K) (proj1_sig (exist (fun n : nat => n < K) (proj1_sig k) H3)) (Nat.le_trans (S (proj1_sig (exist (fun n : nat => n < K) (proj1_sig k) H3))) K (S K) (proj2_sig (exist (fun n : nat => n < K) (proj1_sig k) H3)) (le_S K K (le_n K)))) = k). 1542 | move=> H4. 1543 | rewrite H4. 1544 | reflexivity. 1545 | apply sig_map. 1546 | reflexivity. 1547 | move=> H3. 1548 | suff: ((exist (fun n : nat => n < S K) K (le_n (S K))) = k). 1549 | move=> H4. 1550 | rewrite H4. 1551 | reflexivity. 1552 | apply sig_map. 1553 | elim (le_lt_or_eq (proj1_sig k) K (le_S_n (proj1_sig k) K (proj2_sig k))). 1554 | move=> H4. 1555 | apply False_ind. 1556 | apply (H3 H4). 1557 | move=> H4. 1558 | rewrite H4. 1559 | reflexivity. 1560 | move=> y. 1561 | simpl. 1562 | elim (excluded_middle_informative (K < K)). 1563 | move=> H3. 1564 | apply False_ind. 1565 | apply (lt_irrefl K H3). 1566 | move=> H3. 1567 | apply injective_projections. 1568 | reflexivity. 1569 | apply (BijInj {n : nat | n < M ^ K} ({n : nat | n < K} -> {n : nat | n < M}) g1). 1570 | exists f1. 1571 | apply conj. 1572 | apply (proj2 H2). 1573 | apply (proj1 H2). 1574 | simpl. 1575 | rewrite (proj1 H2 (fun m : {n : nat | n < K} => match excluded_middle_informative (proj1_sig m < K) with 1576 | | left H => g1 (snd y) (exist (fun n : nat => n < K) (proj1_sig m) H) 1577 | | right _ => fst y 1578 | end)). 1579 | apply functional_extensionality. 1580 | move=> k. 1581 | elim (excluded_middle_informative (proj1_sig k < K)). 1582 | move=> H4. 1583 | suff: ((exist (fun n : nat => n < K) (proj1_sig k) H4) = k). 1584 | move=> H5. 1585 | rewrite H5. 1586 | reflexivity. 1587 | apply sig_map. 1588 | reflexivity. 1589 | move=> H4. 1590 | apply False_ind. 1591 | apply (H4 (proj2_sig k)). 1592 | Qed. 1593 | 1594 | Lemma CountPowFinite : forall (N M : nat), Finite ({n : nat | (n < N)%nat} -> {n : nat | (n < M)%nat}) (Full_set ({n : nat | (n < N)%nat} -> {n : nat | (n < M)%nat})). 1595 | Proof. 1596 | move=> N M. 1597 | apply (cardinal_finite ({n : nat | (n < N)%nat} -> {n : nat | (n < M)%nat}) (Full_set ({n : nat | (n < N)%nat} -> {n : nat | (n < M)%nat})) (M ^ N)). 1598 | apply (proj1 (CountCardinalBijective ({n : nat | (n < N)%nat} -> {n : nat | (n < M)%nat}) (M ^ N))). 1599 | elim (proj2_sig (CountPow N M)). 1600 | move=> g H1. 1601 | exists g. 1602 | exists (proj1_sig (CountPow N M)). 1603 | apply conj. 1604 | apply (proj2 H1). 1605 | apply (proj1 H1). 1606 | Qed. 1607 | 1608 | Lemma CountInjBij : forall (N : nat) (f : {n : nat | (n < N)%nat} -> {n : nat | (n < N)%nat}), Injective f -> Bijective f. 1609 | Proof. 1610 | move=> N f H1. 1611 | apply InjSurjBij. 1612 | apply H1. 1613 | suff: (Im {n : nat | (n < N)%nat} {n : nat | (n < N)%nat} (Full_set {n : nat | (n < N)%nat}) f = (Full_set {n : nat | (n < N)%nat})). 1614 | move=> H2 k. 1615 | suff: (In {n : nat | (n < N)%nat} (Im {n : nat | (n < N)%nat} {n : nat | (n < N)%nat} (Full_set {n : nat | (n < N)%nat}) f) k). 1616 | elim. 1617 | move=> x H3 y H4. 1618 | exists x. 1619 | rewrite H4. 1620 | reflexivity. 1621 | rewrite H2. 1622 | apply (Full_intro {n : nat | (n < N)%nat} k). 1623 | suff: (cardinal {n : nat | (n < N)%nat} (Im {n : nat | (n < N)%nat} {n : nat | (n < N)%nat} (Full_set {n : nat | (n < N)%nat}) f) N). 1624 | move=> H2. 1625 | apply Extensionality_Ensembles. 1626 | apply conj. 1627 | move=> k H3. 1628 | apply (Full_intro {n : nat | (n < N)%nat} k). 1629 | move=> k H3. 1630 | apply NNPP. 1631 | move=> H4. 1632 | apply (lt_irrefl N). 1633 | apply (incl_card_le {n : nat | (n < N)%nat} (Add {n : nat | (n < N)%nat} (Im {n : nat | (n < N)%nat} {n : nat | (n < N)%nat} (Full_set {n : nat | (n < N)%nat}) f) k) (Full_set {n : nat | (n < N)%nat}) (S N) N). 1634 | apply (card_add {n : nat | (n < N)%nat}). 1635 | apply H2. 1636 | apply H4. 1637 | apply CountCardinalBijective. 1638 | exists (fun (k : {n : nat | (n < N)%nat}) => k). 1639 | exists (fun (k : {n : nat | (n < N)%nat}) => k). 1640 | apply conj. 1641 | move=> l. 1642 | reflexivity. 1643 | move=> l. 1644 | reflexivity. 1645 | move=> l H5. 1646 | apply (Full_intro {n : nat | (n < N)%nat} l). 1647 | suff: (forall (m : nat), (m <= N)%nat -> cardinal {n : nat | (n < N)%nat} (Im {n : nat | (n < N)%nat} {n : nat | (n < N)%nat} (fun (k : {n : nat | (n < N)%nat}) => (proj1_sig k < m)%nat) f) m). 1648 | move=> H2. 1649 | suff: ((Full_set {n : nat | (n < N)%nat}) = (fun (k : {n : nat | (n < N)%nat}) => (proj1_sig k < N)%nat)). 1650 | move=> H3. 1651 | rewrite H3. 1652 | apply (H2 N). 1653 | apply (le_n N). 1654 | apply Extensionality_Ensembles. 1655 | apply conj. 1656 | move=> k H3. 1657 | apply (proj2_sig k). 1658 | move=> k H3. 1659 | apply (Full_intro {n : nat | (n < N)%nat} k). 1660 | elim. 1661 | move=> H2. 1662 | suff: ((Im {n : nat | (n < N)%nat} {n : nat | (n < N)%nat} (fun (k : {n : nat | (n < N)%nat}) => (proj1_sig k < O)%nat) f) = Empty_set {n : nat | (n < N)%nat}). 1663 | move=> H3. 1664 | rewrite H3. 1665 | apply card_empty. 1666 | apply Extensionality_Ensembles. 1667 | apply conj. 1668 | move=> k. 1669 | elim. 1670 | move=> x H3. 1671 | apply False_ind. 1672 | apply (le_not_lt O (proj1_sig x) (le_0_n (proj1_sig x)) H3). 1673 | move=> k. 1674 | elim. 1675 | move=> m H2 H3. 1676 | suff: ((Im {n : nat | (n < N)%nat} {n : nat | (n < N)%nat} (fun k : {n : nat | (n < N)%nat} => (proj1_sig k < S m)%nat) f) = Add {n : nat | (n < N)%nat} (Im {n : nat | (n < N)%nat} {n : nat | (n < N)%nat} (fun k : {n : nat | (n < N)%nat} => (proj1_sig k < m)%nat) f) (f (exist (fun (n : nat) => (n < N)%nat) m H3))). 1677 | move=> H4. 1678 | rewrite H4. 1679 | apply card_add. 1680 | apply (H2 (le_trans m (S m) N (le_S m m (le_n m)) H3)). 1681 | move=> H5. 1682 | suff: (forall (k : {n : nat | (n < N)%nat}), (proj1_sig k < m)%nat -> f k <> f (exist (fun n : nat => (n < N)%nat) m H3)). 1683 | elim H5. 1684 | move=> x H6 y H7 H8. 1685 | apply (H8 x H6). 1686 | rewrite H7. 1687 | reflexivity. 1688 | move=> k H6 H7. 1689 | apply (lt_irrefl (proj1_sig k)). 1690 | suff: (k = (exist (fun n : nat => (n < N)%nat) m H3)). 1691 | move=> H8. 1692 | rewrite {2} H8. 1693 | apply H6. 1694 | apply H1. 1695 | apply H7. 1696 | apply Extensionality_Ensembles. 1697 | apply conj. 1698 | move=> k. 1699 | elim. 1700 | move=> x H4 y H5. 1701 | rewrite H5. 1702 | elim (le_lt_or_eq (proj1_sig x) m). 1703 | move=> H6. 1704 | left. 1705 | apply (Im_intro {n : nat | (n < N)%nat} {n : nat | (n < N)%nat} (fun (k : {n : nat | (n < N)%nat}) => (proj1_sig k < m)%nat) f x H6). 1706 | reflexivity. 1707 | move=> H6. 1708 | right. 1709 | suff: (x = (exist (fun n : nat => (n < N)%nat) m H3)). 1710 | move=> H7. 1711 | rewrite H7. 1712 | apply In_singleton. 1713 | apply sig_map. 1714 | apply H6. 1715 | apply le_S_n. 1716 | apply H4. 1717 | move=> k. 1718 | elim. 1719 | move=> k0. 1720 | elim. 1721 | move=> x H4 y H5. 1722 | apply (Im_intro {n : nat | (n < N)%nat} {n : nat | (n < N)%nat} (fun (k : {n : nat | (n < N)%nat}) => (proj1_sig k < S m)%nat) f x). 1723 | apply (le_trans (S (proj1_sig x)) m (S m) H4 (le_S m m (le_n m))). 1724 | apply H5. 1725 | move=> x. 1726 | elim. 1727 | apply (Im_intro {n : nat | (n < N)%nat} {n : nat | (n < N)%nat} (fun (k : {n : nat | (n < N)%nat}) => (proj1_sig k < S m)%nat) f (exist (fun n : nat => (n < N)%nat) m H3)). 1728 | apply (le_n (S m)). 1729 | reflexivity. 1730 | Qed. 1731 | 1732 | Lemma SkipOneSig : forall (N : nat) (m : {n : nat | n < N}), {f : {n : nat | n < pred N} -> {n : nat | n < N} | forall (k : {n : nat | n < pred N}), (proj1_sig k < proj1_sig m -> proj1_sig (f k) = proj1_sig k) /\ (proj1_sig k >= proj1_sig m -> proj1_sig (f k) = S (proj1_sig k))}. 1733 | Proof. 1734 | elim. 1735 | move=> m. 1736 | apply constructive_definite_description. 1737 | apply False_ind. 1738 | apply (le_not_lt 0 (proj1_sig m) (le_0_n (proj1_sig m)) (proj2_sig m)). 1739 | move=> k H1 m. 1740 | simpl. 1741 | suff: (forall (l : {n : nat | n < k}), proj1_sig l < S k). 1742 | move=> H2. 1743 | suff: (forall (l : {n : nat | n < k}), S (proj1_sig l) < S k). 1744 | move=> H3. 1745 | exists (fun (l : {n : nat | n < k}) => match excluded_middle_informative (proj1_sig l < proj1_sig m) with 1746 | | left _ => exist (fun (n : nat) => n < S k) (proj1_sig l) (H2 l) 1747 | | right _ => exist (fun (n : nat) => n < S k) (S (proj1_sig l)) (H3 l) 1748 | end). 1749 | move=> l. 1750 | apply conj. 1751 | move=> H4. 1752 | elim (excluded_middle_informative (proj1_sig l < proj1_sig m)). 1753 | move=> H5. 1754 | reflexivity. 1755 | move=> H5. 1756 | apply False_ind. 1757 | apply (H5 H4). 1758 | move=> H4. 1759 | elim (excluded_middle_informative (proj1_sig l < proj1_sig m)). 1760 | move=> H5. 1761 | apply False_ind. 1762 | apply (le_not_lt (proj1_sig m) (proj1_sig l) H4 H5). 1763 | move=> H5. 1764 | reflexivity. 1765 | move=> l. 1766 | apply (lt_n_S (proj1_sig l) k (proj2_sig l)). 1767 | move=> l. 1768 | apply (le_S (S (proj1_sig l)) k (proj2_sig l)). 1769 | Qed. 1770 | 1771 | Definition SkipOne (N : nat) (m : {n : nat | n < N}) := proj1_sig (SkipOneSig N m). 1772 | 1773 | Definition SkipOneNature (N : nat) (m : {n : nat | n < N}) : forall (k : {n : nat | n < pred N}), (proj1_sig k < proj1_sig m -> proj1_sig ((SkipOne N m) k) = proj1_sig k) /\ (proj1_sig k >= proj1_sig m -> proj1_sig ((SkipOne N m) k) = S (proj1_sig k)) := proj2_sig (SkipOneSig N m). 1774 | 1775 | Lemma SkipOneInj : forall (N : nat) (m : {n : nat | n < N}), Injective (SkipOne N m). 1776 | Proof. 1777 | elim. 1778 | move=> m. 1779 | apply False_ind. 1780 | apply (le_not_lt O (proj1_sig m) (le_0_n (proj1_sig m)) (proj2_sig m)). 1781 | move=> N H1 m k1 k2 H2. 1782 | elim (le_or_lt (proj1_sig m) (proj1_sig k1)). 1783 | move=> H3. 1784 | elim (le_or_lt (proj1_sig m) (proj1_sig k2)). 1785 | move=> H4. 1786 | apply sig_map. 1787 | apply (Nat.succ_inj (proj1_sig k1) (proj1_sig k2)). 1788 | rewrite - (proj2 (SkipOneNature (S N) m k1) H3). 1789 | rewrite - (proj2 (SkipOneNature (S N) m k2) H4). 1790 | rewrite H2. 1791 | reflexivity. 1792 | move=> H4. 1793 | apply False_ind. 1794 | apply (le_not_lt (proj1_sig (SkipOne (S N) m k1)) (proj1_sig (SkipOne (S N) m k2))). 1795 | rewrite H2. 1796 | apply (le_n (proj1_sig (SkipOne (S N) m k2))). 1797 | rewrite (proj1 (SkipOneNature (S N) m k2) H4). 1798 | rewrite (proj2 (SkipOneNature (S N) m k1) H3). 1799 | apply (lt_trans (proj1_sig k2) (proj1_sig m) (S (proj1_sig k1)) H4). 1800 | apply (le_n_S (proj1_sig m) (proj1_sig k1) H3). 1801 | move=> H3. 1802 | elim (le_or_lt (proj1_sig m) (proj1_sig k2)). 1803 | move=> H4. 1804 | apply False_ind. 1805 | apply (le_not_lt (proj1_sig (SkipOne (S N) m k2)) (proj1_sig (SkipOne (S N) m k1))). 1806 | rewrite H2. 1807 | apply (le_n (proj1_sig (SkipOne (S N) m k2))). 1808 | rewrite (proj1 (SkipOneNature (S N) m k1) H3). 1809 | rewrite (proj2 (SkipOneNature (S N) m k2) H4). 1810 | apply (lt_trans (proj1_sig k1) (proj1_sig m) (S (proj1_sig k2)) H3). 1811 | apply (le_n_S (proj1_sig m) (proj1_sig k2) H4). 1812 | move=> H4. 1813 | apply sig_map. 1814 | rewrite - (proj1 (SkipOneNature (S N) m k1) H3). 1815 | rewrite - (proj1 (SkipOneNature (S N) m k2) H4). 1816 | rewrite H2. 1817 | reflexivity. 1818 | Qed. 1819 | 1820 | Lemma SkipOneMonotonicallyIncreasing : forall (N : nat) (m : {n : nat | n < N}) (k1 k2 : {n : nat | n < pred N}), proj1_sig k1 < proj1_sig k2 -> proj1_sig (SkipOne N m k1) < proj1_sig (SkipOne N m k2). 1821 | Proof. 1822 | elim. 1823 | move=> m. 1824 | apply False_ind. 1825 | apply (le_not_lt O (proj1_sig m) (le_0_n (proj1_sig m)) (proj2_sig m)). 1826 | move=> N H1 m k1 k2 H2. 1827 | elim (le_or_lt (proj1_sig m) (proj1_sig k1)). 1828 | move=> H3. 1829 | rewrite (proj2 (SkipOneNature (S N) m k1) H3). 1830 | rewrite (proj2 (SkipOneNature (S N) m k2) (le_trans (proj1_sig m) (proj1_sig k1) (proj1_sig k2) H3 (lt_le_weak (proj1_sig k1) (proj1_sig k2) H2))). 1831 | apply (le_n_S (S (proj1_sig k1)) (proj1_sig k2) H2). 1832 | move=> H3. 1833 | rewrite (proj1 (SkipOneNature (S N) m k1) H3). 1834 | elim (le_or_lt (proj1_sig m) (proj1_sig k2)). 1835 | move=> H4. 1836 | rewrite (proj2 (SkipOneNature (S N) m k2) H4). 1837 | apply (le_S (S (proj1_sig k1)) (proj1_sig k2) H2). 1838 | move=> H4. 1839 | rewrite (proj1 (SkipOneNature (S N) m k2) H4). 1840 | apply H2. 1841 | Qed. 1842 | -------------------------------------------------------------------------------- /BasicProperty/NatProperty.v: -------------------------------------------------------------------------------- 1 | From mathcomp Require Import ssreflect. 2 | Require Import Classical. 3 | Require Import Coq.Logic.Description. 4 | Require Import Coq.Sets.Ensembles. 5 | Require Import Coq.Sets.Finite_sets. 6 | Require Import Coq.Sets.Finite_sets_facts. 7 | Require Import Coq.Arith.PeanoNat. 8 | Require Import Coq.Arith.Le. 9 | Require Import Coq.Arith.Lt. 10 | 11 | Definition is_max_nat := fun (E : (Ensemble nat)) (m : nat) => (In nat E m) /\ forall x : nat, (In nat E x) -> (x <= m)%nat. 12 | 13 | Definition is_min_nat := fun (E : (Ensemble nat)) (m : nat) => (In nat E m) /\ forall x : nat, (In nat E x) -> (x >= m)%nat. 14 | 15 | Lemma is_max_nat_unique : forall (E : (Ensemble nat)) (m1 m2 : nat), is_max_nat E m1 -> is_max_nat E m2 -> m1 = m2. 16 | Proof. 17 | move=> E m1 m2 H1 H2. 18 | apply (le_antisym m1 m2). 19 | apply (proj2 H2 m1 (proj1 H1)). 20 | apply (proj2 H1 m2 (proj1 H2)). 21 | Qed. 22 | 23 | Lemma is_min_nat_unique : forall (E : (Ensemble nat)) (m1 m2 : nat), is_min_nat E m1 -> is_min_nat E m2 -> m1 = m2. 24 | Proof. 25 | move=> E m1 m2 H1 H2. 26 | apply (le_antisym m1 m2). 27 | apply (proj2 H1 m2 (proj1 H2)). 28 | apply (proj2 H2 m1 (proj1 H1)). 29 | Qed. 30 | 31 | Lemma nat_cardinal : forall (n : nat) , cardinal nat (fun x : nat => (x < n)%nat) n. 32 | Proof. 33 | move=> n. 34 | elim n. 35 | suff: (fun x : nat => (x < 0)%nat) = (Empty_set nat). 36 | move=> H1. 37 | rewrite H1. 38 | apply (card_empty nat). 39 | apply (Extensionality_Ensembles nat (fun x : nat => (x < 0)%nat) (Empty_set nat)). 40 | apply conj. 41 | move=> m H1. 42 | apply False_ind. 43 | apply (le_not_lt 0 m). 44 | apply (le_O_n m). 45 | apply H1. 46 | move=> m. 47 | elim. 48 | move=> n0 H1. 49 | suff: (Add nat (fun x : nat => (x < n0)%nat) n0) = (fun x : nat => (x < S n0)%nat). 50 | move=> H2. 51 | rewrite - H2. 52 | apply (card_add nat (fun x : nat => (x < n0)%nat) n0 H1 n0). 53 | move=> H3. 54 | apply (le_Sn_n n0 H3). 55 | apply (Extensionality_Ensembles nat (Add nat (fun x : nat => (x < n0)%nat) n0) (fun x : nat => (x < S n0)%nat)). 56 | apply conj. 57 | move=> x. 58 | elim. 59 | move=> x0 H2. 60 | apply (lt_trans x0 n0 (S n0)). 61 | apply H2. 62 | by []. 63 | move=> x0 H2. 64 | rewrite H2. 65 | by []. 66 | move=> x H2. 67 | elim (le_lt_or_eq (S x) (S n0)). 68 | move=> H3. 69 | apply (Union_introl nat (fun x0 : nat => (x0 < n0)%nat) (Singleton nat n0) x). 70 | apply (lt_S_n x n0 H3). 71 | move=> H3. 72 | apply (Union_intror nat (fun x0 : nat => (x0 < n0)%nat) (Singleton nat n0) x). 73 | rewrite - (Nat.pred_succ n0). 74 | rewrite - (Nat.pred_succ x). 75 | rewrite H3. 76 | by []. 77 | apply H2. 78 | Qed. 79 | 80 | Lemma Finite_max_nat_exist : forall (U : Ensemble nat), (Finite nat U) -> (Inhabited nat U) -> exists m : nat, (is_max_nat U m). 81 | Proof. 82 | move=> U H1. 83 | elim H1. 84 | move=> H2. 85 | apply False_ind. 86 | elim H2. 87 | move=> x H3. 88 | elim H3. 89 | move=> A H2 H3 x H4 H5. 90 | move: H3. 91 | elim H2. 92 | exists x. 93 | apply conj. 94 | apply (Union_intror nat (Empty_set nat) (Singleton nat x) x). 95 | apply (In_singleton nat x). 96 | move=> x0. 97 | elim. 98 | move=> x1. 99 | elim. 100 | move=> x1. 101 | elim. 102 | by []. 103 | move=> A0 H6 H7 x0 H8. 104 | elim. 105 | move=> x1. 106 | move=> H9. 107 | exists (max x x1). 108 | apply conj. 109 | apply (Nat.max_case_strong x x1). 110 | move=> H10. 111 | apply (Union_intror nat (Add nat A0 x0) (Singleton nat x) x). 112 | apply (In_singleton nat x). 113 | move=> H10. 114 | apply (Union_introl nat (Add nat A0 x0) (Singleton nat x) x1). 115 | apply (proj1 H9). 116 | move=> x2. 117 | elim. 118 | move=> x3 H10. 119 | apply (le_trans x3 x1 (Init.Nat.max x x1)). 120 | apply (proj2 H9 x3 H10). 121 | apply (Nat.le_max_r x x1). 122 | move=> x3. 123 | elim. 124 | apply (Nat.le_max_l x x1). 125 | exists x0. 126 | apply (Union_intror nat A0 (Singleton nat x0) x0). 127 | apply (In_singleton nat x0). 128 | Qed. 129 | 130 | Lemma min_nat_exist : forall (U : Ensemble nat), (Inhabited nat U) -> exists m : nat, (is_min_nat U m). 131 | Proof. 132 | suff: (forall (U : Ensemble nat), (Finite nat U) -> (Inhabited nat U) -> exists m : nat, (is_min_nat U m)). 133 | move=> H1 U. 134 | elim. 135 | move=> n H2. 136 | elim (classic (Inhabited nat (Intersection nat U (fun x:nat => (x < n)%nat)))). 137 | move=> H3. 138 | elim (H1 (Intersection nat U (fun x : nat => (x < n)%nat))). 139 | move=> x H4. 140 | exists x. 141 | apply conj. 142 | elim (proj1 H4). 143 | move=> y H5 H6. 144 | apply H5. 145 | move=> y. 146 | elim (le_or_lt n y). 147 | move=> H5 H6. 148 | apply (le_trans x n y). 149 | apply (le_trans x (S x) n). 150 | apply (le_S x). 151 | apply (le_n x). 152 | elim (proj1 H4). 153 | move=> y0 H7. 154 | apply. 155 | apply H5. 156 | move=> H5 H6. 157 | apply ((proj2 H4) y). 158 | apply (Intersection_intro nat U (fun x0 : nat => (x0 < n)%nat) y H6). 159 | apply H5. 160 | suff: (Finite nat (fun x : nat => (x < n)%nat)). 161 | move=> H4. 162 | apply (Intersection_preserves_finite nat (fun x : nat => (x < n)%nat) H4 U). 163 | apply (cardinal_finite nat (fun x : nat => (x < n)%nat) n (nat_cardinal n)). 164 | apply H3. 165 | move=> H3. 166 | exists n. 167 | apply conj. 168 | apply H2. 169 | move=> x H4. 170 | elim (le_or_lt n x). 171 | apply. 172 | move=> H5. 173 | apply False_ind. 174 | apply H3. 175 | apply (Inhabited_intro nat (Intersection nat U (fun x0 : nat => (x0 < n)%nat)) x). 176 | apply (Intersection_intro nat U (fun x0 : nat => (x0 < n)%nat) x H4 H5). 177 | move=> U H1. 178 | elim H1. 179 | move=> H2. 180 | apply False_ind. 181 | elim H2. 182 | move=> x H3. 183 | elim H3. 184 | move=> A H2 H3 x H4 H5. 185 | suff: (Inhabited nat A -> exists m : nat, is_min_nat A m). 186 | elim H2. 187 | move=> H6. 188 | exists x. 189 | apply conj. 190 | apply (Union_intror nat (Empty_set nat) (Singleton nat x) x). 191 | apply (In_singleton nat x). 192 | move=> x0. 193 | elim. 194 | move=> x1. 195 | elim. 196 | move=> x1. 197 | elim. 198 | by []. 199 | move=> A0 H6 H7 x0 H8. 200 | elim. 201 | move=> x1 H9. 202 | exists (min x x1). 203 | apply conj. 204 | apply (Nat.min_case_strong x x1). 205 | move=> H10. 206 | apply (Union_intror nat (Add nat A0 x0) (Singleton nat x) x). 207 | apply (In_singleton nat x). 208 | move=> H10. 209 | apply (Union_introl nat (Add nat A0 x0) (Singleton nat x) x1). 210 | apply (proj1 H9). 211 | move=> x2. 212 | elim. 213 | move=> x3 H10. 214 | apply (le_trans (min x x1) x1 x3). 215 | apply (Nat.le_min_r x x1). 216 | apply (proj2 H9 x3 H10). 217 | move=> x3. 218 | elim. 219 | apply (Nat.le_min_l x x1). 220 | exists x0. 221 | apply (Union_intror nat A0 (Singleton nat x0) x0). 222 | apply (In_singleton nat x0). 223 | apply H3. 224 | Qed. 225 | 226 | Lemma min_nat_get : forall (U : Ensemble nat), (Inhabited nat U) -> {m : nat | is_min_nat U m}. 227 | Proof. 228 | move=> U H1. 229 | apply (constructive_definite_description (fun (m : nat) => is_min_nat U m)). 230 | apply (proj1 (unique_existence (fun (m : nat) => is_min_nat U m))). 231 | apply conj. 232 | elim (min_nat_exist U H1). 233 | move=> n H2. 234 | exists n. 235 | apply H2. 236 | unfold uniqueness. 237 | apply (is_min_nat_unique U). 238 | Qed. 239 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2021 Haruka Kawamura 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /LibraryExtension/ComposeExtension.v: -------------------------------------------------------------------------------- 1 | From mathcomp Require Import ssreflect. 2 | Require Import Coq.Logic.FunctionalExtensionality. 3 | Require Import Coq.Program.Basics. 4 | Require Import Coq.Program.Combinators. 5 | Require Import Coq.Arith.Plus. 6 | 7 | Fixpoint repeat_compose (T : Type) (f : T -> T) (n : nat) : T -> T := match n with 8 | | O => Datatypes.id 9 | | S m => compose f (repeat_compose T f m) 10 | end. 11 | 12 | Lemma repeat_compose_add : forall (T : Type) (f : T -> T) (n m : nat), repeat_compose T f (n + m) = compose (repeat_compose T f n) (repeat_compose T f m). 13 | Proof. 14 | move=> T f. 15 | elim. 16 | move=> m. 17 | reflexivity. 18 | move=> n H1 m. 19 | simpl. 20 | rewrite H1. 21 | reflexivity. 22 | Qed. 23 | 24 | Lemma repeat_compose_def2 : forall (T : Type) (f : T -> T), repeat_compose T f = fix rep (n : nat) : T -> T := match n with 25 | | O => Datatypes.id 26 | | S m => compose (rep m) f 27 | end. 28 | Proof. 29 | move=> T f. 30 | apply functional_extensionality. 31 | elim. 32 | reflexivity. 33 | move=> n H1. 34 | simpl. 35 | rewrite - H1. 36 | rewrite - {1} (compose_id_right T T f). 37 | rewrite - {4} (compose_id_right T T f). 38 | suff: (compose (compose f Datatypes.id) (repeat_compose T f n) = repeat_compose T f (n + 1)). 39 | move=> H2. 40 | rewrite H2. 41 | apply (repeat_compose_add T f n 1). 42 | rewrite (plus_comm n 1). 43 | reflexivity. 44 | Qed. 45 | -------------------------------------------------------------------------------- /LibraryExtension/DatatypesExtension.v: -------------------------------------------------------------------------------- 1 | From mathcomp Require Import ssreflect. 2 | 3 | Lemma injective_inl : forall (T1 T2 : Type) (t1 t2 : T1), inl T2 t1 = inl T2 t2 -> t1 = t2. 4 | Proof. 5 | move=> T1 T2 t1 t2 H1. 6 | suff: (let f := fun (t : sum T1 T2) => match t with 7 | | inl t0 => t0 8 | | inr _ => t1 9 | end in t1 = t2). 10 | apply. 11 | move=> f. 12 | suff: (t1 = f (inl t1)). 13 | move=> H2. 14 | rewrite H2. 15 | rewrite H1. 16 | reflexivity. 17 | reflexivity. 18 | Qed. 19 | 20 | Lemma injective_inr : forall (T1 T2 : Type) (t1 t2 : T2), inr T1 t1 = inr T1 t2 -> t1 = t2. 21 | Proof. 22 | move=> T1 T2 t1 t2 H1. 23 | suff: (let f := fun (t : sum T1 T2) => match t with 24 | | inl _ => t1 25 | | inr t0 => t0 26 | end in t1 = t2). 27 | apply. 28 | move=> f. 29 | suff: (t1 = f (inr t1)). 30 | move=> H2. 31 | rewrite H2. 32 | rewrite H1. 33 | reflexivity. 34 | reflexivity. 35 | Qed. 36 | 37 | Inductive sumT (T : Type) (tf : T -> Type) : Type := 38 | | inT : forall (t : T), (tf t) -> sumT T tf. 39 | -------------------------------------------------------------------------------- /LibraryExtension/EnsemblesExtension.v: -------------------------------------------------------------------------------- 1 | From mathcomp Require Import ssreflect. 2 | Require Import Coq.Sets.Ensembles. 3 | 4 | Inductive IntersectionT (U : Type) (T : Type) (A : T -> Ensemble U) : Ensemble U := 5 | | IntersectionT_intro : forall (x : U), (forall (t : T), In U (A t) x) -> In U (IntersectionT U T A) x. 6 | 7 | Inductive UnionT (U : Type) (T : Type) (A : T -> Ensemble U) : Ensemble U := 8 | | UnionT_intro : forall (x : U) (t : T), In U (A t) x -> In U (UnionT U T A) x. 9 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: Tools/BasicTools.vo BasicProperty/NatProperty.vo BasicProperty/MappingProperty.vo Tools/MyProd.vo Tools/MySum.vo BasicNotation/Parity.vo BasicNotation/Permutation.vo LibraryExtension/ComposeExtension.vo LibraryExtension/DatatypesExtension.vo LibraryExtension/EnsemblesExtension.vo MyAlgebraicStructure/MyField.vo MyAlgebraicStructure/MyVectorSpace.vo LinearAlgebra/SenkeiDaisuunoSekai/SenkeiDaisuunoSekai1.vo LinearAlgebra/Matrix.vo Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn1.vo Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn1AC.vo Analysis/KaisekiNyuumonn/KaisekiNyuumonn1_1.vo Analysis/KaisekiNyuumonn/KaisekiNyuumonn1_2.vo Analysis/KaisekiNyuumonn/KaisekiNyuumonn2.vo Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn2.vo Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn2AC.vo 2 | 3 | Tools/BasicTools.vo: Tools/BasicTools.v 4 | coqc -Q Tools Tools Tools/BasicTools.v 5 | 6 | BasicProperty/NatProperty.vo: BasicProperty/NatProperty.v 7 | coqc -Q BasicProperty BasicProperty BasicProperty/NatProperty.v 8 | 9 | BasicProperty/MappingProperty.vo: BasicProperty/MappingProperty.v 10 | coqc -Q BasicProperty BasicProperty BasicProperty/MappingProperty.v 11 | 12 | Tools/MyProd.vo: Tools/MyProd.v 13 | coqc -Q Tools Tools Tools/MyProd.v 14 | 15 | Tools/MySum.vo: Tools/MySum.v 16 | coqc -Q Tools Tools Tools/MySum.v 17 | 18 | BasicNotation/Parity.vo: BasicNotation/Parity.v Tools/MySum.vo 19 | coqc -Q BasicNotation BasicNotation BasicNotation/Parity.v 20 | 21 | BasicNotation/Permutation.vo: BasicNotation/Permutation.v BasicNotation/Parity.vo Tools/MySum.vo 22 | coqc -Q BasicNotation BasicNotation BasicNotation/Permutation.v 23 | 24 | LibraryExtension/ComposeExtension.vo: LibraryExtension/ComposeExtension.v 25 | coqc -Q LibraryExtension LibraryExtension LibraryExtension/ComposeExtension.v 26 | 27 | LibraryExtension/DatatypesExtension.vo: LibraryExtension/DatatypesExtension.v 28 | coqc -Q LibraryExtension LibraryExtension LibraryExtension/DatatypesExtension.v 29 | 30 | LibraryExtension/EnsemblesExtension.vo: LibraryExtension/EnsemblesExtension.v 31 | coqc -Q LibraryExtension LibraryExtension LibraryExtension/EnsemblesExtension.v 32 | 33 | MyAlgebraicStructure/MyField.vo: MyAlgebraicStructure/MyField.v BasicProperty/NatProperty.vo 34 | coqc -Q MyAlgebraicStructure MyAlgebraicStructure MyAlgebraicStructure/MyField.v 35 | 36 | MyAlgebraicStructure/MyVectorSpace.vo: MyAlgebraicStructure/MyVectorSpace.v MyAlgebraicStructure/MyField.vo BasicProperty/MappingProperty.vo 37 | coqc -Q MyAlgebraicStructure MyAlgebraicStructure MyAlgebraicStructure/MyVectorSpace.v 38 | 39 | LinearAlgebra/SenkeiDaisuunoSekai/SenkeiDaisuunoSekai1.vo: MyAlgebraicStructure/MyField.v MyAlgebraicStructure/MyVectorSpace.vo BasicProperty/MappingProperty.vo BasicProperty/NatProperty.vo Tools/MySum.vo Tools/BasicTools.vo LibraryExtension/DatatypesExtension.vo LibraryExtension/EnsemblesExtension.vo 40 | coqc -Q LinearAlgebra/SenkeiDaisuunoSekai LinearAlgebra.SenkeiDaisuunoSekai LinearAlgebra/SenkeiDaisuunoSekai/SenkeiDaisuunoSekai1.v 41 | 42 | LinearAlgebra/Matrix.vo: LinearAlgebra/Matrix.v MyAlgebraicStructure/MyField.vo MyAlgebraicStructure/MyVectorSpace.vo Tools/MySum.vo Tools/MyProd.vo 43 | coqc -Q LinearAlgebra LinearAlgebra LinearAlgebra/Matrix.v 44 | 45 | Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn1.vo: Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn1.v Tools/MySum.vo BasicProperty/MappingProperty.vo LibraryExtension/EnsemblesExtension.vo 46 | coqc -Q Topology/ShuugouIsouNyuumonn Topology.ShuugouIsouNyuumonn Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn1.v 47 | 48 | Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn1AC.vo: Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn1AC.v Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn1.vo BasicProperty/MappingProperty.vo 49 | coqc -Q Topology/ShuugouIsouNyuumonn Topology.ShuugouIsouNyuumonn Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn1AC.v 50 | 51 | Analysis/KaisekiNyuumonn/KaisekiNyuumonn1_1.vo: Analysis/KaisekiNyuumonn/KaisekiNyuumonn1_1.v 52 | coqc -Q Analysis/KaisekiNyuumonn Analysis.KaisekiNyuumonn Analysis/KaisekiNyuumonn/KaisekiNyuumonn1_1.v 53 | 54 | Analysis/KaisekiNyuumonn/KaisekiNyuumonn1_2.vo: Analysis/KaisekiNyuumonn/KaisekiNyuumonn1_2.v Analysis/KaisekiNyuumonn/KaisekiNyuumonn1_1.vo MyAlgebraicStructure/MyField.vo MyAlgebraicStructure/MyVectorSpace.vo Tools/MySum.vo 55 | coqc -Q Analysis/KaisekiNyuumonn Analysis.KaisekiNyuumonn Analysis/KaisekiNyuumonn/KaisekiNyuumonn1_2.v 56 | 57 | Analysis/KaisekiNyuumonn/KaisekiNyuumonn2.vo: Analysis/KaisekiNyuumonn/KaisekiNyuumonn2.v BasicProperty/MappingProperty.vo LibraryExtension/ComposeExtension.vo MyAlgebraicStructure/MyField.vo MyAlgebraicStructure/MyVectorSpace.vo Tools/MySum.vo Analysis/KaisekiNyuumonn/KaisekiNyuumonn1_1.vo Analysis/KaisekiNyuumonn/KaisekiNyuumonn1_2.vo 58 | coqc -Q Analysis/KaisekiNyuumonn Analysis.KaisekiNyuumonn Analysis/KaisekiNyuumonn/KaisekiNyuumonn2.v 59 | 60 | Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn2.vo: Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn2.v BasicProperty/MappingProperty.vo LibraryExtension/EnsemblesExtension.vo Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn1.vo LibraryExtension/DatatypesExtension.vo Analysis/KaisekiNyuumonn/KaisekiNyuumonn1_1.vo BasicProperty/NatProperty.vo 61 | coqc -Q Topology/ShuugouIsouNyuumonn Topology.ShuugouIsouNyuumonn Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn2.v 62 | 63 | Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn2AC.vo: Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn2AC.v Tools/BasicTools.vo BasicProperty/MappingProperty.vo LibraryExtension/DatatypesExtension.vo Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn1.vo Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn1AC.vo Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn2.vo 64 | coqc -Q Topology/ShuugouIsouNyuumonn Topology.ShuugouIsouNyuumonn Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn2AC.v 65 | 66 | clean: 67 | find . -type f | grep -E "(.*\.vo)|(.*\.glob)|(.*\.aux)" - | xargs rm -------------------------------------------------------------------------------- /MyAlgebraicStructure/MyField.v: -------------------------------------------------------------------------------- 1 | Add LoadPath "BasicProperty" as BasicProperty. 2 | Add LoadPath "Tools" as Tools. 3 | 4 | From mathcomp Require Import ssreflect. 5 | Require Import Classical. 6 | Require Import Coq.Logic.ClassicalDescription. 7 | Require Import Coq.Sets.Ensembles. 8 | Require Import Coq.Sets.Finite_sets. 9 | Require Import BasicProperty.NatProperty. 10 | Require Import Tools.MySum. 11 | 12 | Section Field. 13 | 14 | Record Field : Type := mkField 15 | { 16 | FT : Type; 17 | FO : FT; 18 | FI : FT; 19 | Fadd : FT -> FT -> FT; 20 | Fmul : FT -> FT -> FT; 21 | Fopp : FT -> FT; 22 | Finv : FT -> FT; 23 | Fadd_assoc : forall (x y z : FT), (Fadd (Fadd x y) z) = (Fadd x (Fadd y z)); 24 | Fmul_assoc : forall (x y z : FT), (Fmul (Fmul x y) z) = (Fmul x (Fmul y z)); 25 | Fadd_comm : forall (x y : FT), (Fadd x y) = (Fadd y x); 26 | Fmul_comm : forall (x y : FT), (Fmul x y) = (Fmul y x); 27 | Fadd_O_l : forall x : FT, (Fadd FO x) = x; 28 | Fmul_I_l : forall x : FT, (Fmul FI x) = x; 29 | Fadd_opp_r : forall x : FT, (Fadd x (Fopp x)) = FO; 30 | Finv_l : forall x : FT, x <> FO -> (Fmul (Finv x) x) = FI; 31 | Fmul_add_distr_l : forall (x y z : FT), (Fmul x (Fadd y z)) = (Fadd (Fmul x y) (Fmul x z)); 32 | FI_neq_FO : FI <> FO 33 | }. 34 | 35 | Definition Fminus (f : Field) (x y : FT f) := Fadd f x (Fopp f y). 36 | 37 | Lemma Fmul_assoc_reverse : forall (f : Field) (x y z : FT f), (Fmul f x (Fmul f y z)) = (Fmul f (Fmul f x y) z). 38 | Proof. 39 | move=> f x y z. 40 | rewrite (Fmul_assoc f x y z). 41 | reflexivity. 42 | Qed. 43 | 44 | Lemma Fadd_O_r : forall (f : Field) (x : FT f), (Fadd f x (FO f)) = x. 45 | Proof. 46 | move=> f x. 47 | rewrite (Fadd_comm f x (FO f)). 48 | apply (Fadd_O_l f x). 49 | Qed. 50 | 51 | Lemma Fadd_ne : forall (f : Field) (x : FT f), (Fadd f x (FO f)) = x /\ (Fadd f (FO f) x) = x. 52 | Proof. 53 | move=> f x. 54 | apply conj. 55 | apply (Fadd_O_r f x). 56 | apply (Fadd_O_l f x). 57 | Qed. 58 | 59 | Lemma Fadd_opp_l : forall (f : Field) (x : FT f), (Fadd f (Fopp f x) x) = (FO f). 60 | Proof. 61 | move=> f x. 62 | rewrite (Fadd_comm f (Fopp f x) x). 63 | apply (Fadd_opp_r f x). 64 | Qed. 65 | 66 | Lemma Fadd_opp_r_uniq : forall (f : Field) (x y : FT f), (Fadd f x y) = (FO f) -> y = (Fopp f x). 67 | Proof. 68 | move=> f x y H1. 69 | suff: (Fadd f (Fopp f x) (Fadd f x y)) = (Fadd f (Fopp f x) (FO f)). 70 | move=> H2. 71 | rewrite - (Fadd_O_r f (Fopp f x)). 72 | rewrite - H2. 73 | rewrite - (Fadd_assoc f (Fopp f x) x y). 74 | rewrite (Fadd_opp_l f x). 75 | rewrite (Fadd_O_l f y). 76 | by []. 77 | rewrite H1. 78 | by []. 79 | Qed. 80 | 81 | Lemma Fadd_eq_compat_l : forall (f : Field) (x y z : FT f), y = z -> (Fadd f x y) = (Fadd f x z). 82 | Proof. 83 | move=> f x y z H1. 84 | rewrite H1. 85 | by []. 86 | Qed. 87 | 88 | Lemma Fadd_eq_compat_r : forall (f : Field) (x y z : FT f), y = z -> (Fadd f y x) = (Fadd f z x). 89 | Proof. 90 | move=> f x y z H1. 91 | rewrite H1. 92 | by []. 93 | Qed. 94 | 95 | Lemma Fadd_eq_reg_l : forall (f : Field) (x y z : FT f), (Fadd f x y) = (Fadd f x z) -> y = z. 96 | Proof. 97 | move=> f x y z H1. 98 | rewrite - (Fadd_O_l f y). 99 | rewrite - (Fadd_O_l f z). 100 | rewrite - (Fadd_opp_l f x). 101 | rewrite (Fadd_assoc f (Fopp f x) x y). 102 | rewrite (Fadd_assoc f (Fopp f x) x z). 103 | apply (Fadd_eq_compat_l f (Fopp f x) (Fadd f x y) (Fadd f x z)). 104 | by []. 105 | Qed. 106 | 107 | Lemma Fadd_eq_reg_r : forall (f : Field) (x y z : FT f), (Fadd f y x) = (Fadd f z x) -> y = z. 108 | Proof. 109 | move=> f x y z H1. 110 | rewrite - (Fadd_O_r f y). 111 | rewrite - (Fadd_O_r f z). 112 | rewrite - (Fadd_opp_r f x). 113 | rewrite - (Fadd_assoc f y x (Fopp f x)). 114 | rewrite - (Fadd_assoc f z x (Fopp f x)). 115 | apply (Fadd_eq_compat_r f (Fopp f x) (Fadd f y x) (Fadd f z x)). 116 | by []. 117 | Qed. 118 | 119 | Lemma Fadd_O_r_uniq : forall (f : Field) (x y : FT f), (Fadd f x y) = x -> y = (FO f). 120 | Proof. 121 | move=> f x y H1. 122 | rewrite - (Fadd_O_l f y). 123 | rewrite - (Fadd_opp_l f x). 124 | rewrite (Fadd_assoc f (Fopp f x) x y). 125 | rewrite H1. 126 | by []. 127 | Qed. 128 | 129 | Lemma Finv_r : forall (f : Field) (x : FT f), x <> (FO f) -> (Fmul f x (Finv f x)) = (FI f). 130 | Proof. 131 | move=> f x H1. 132 | rewrite (Fmul_comm f x (Finv f x)). 133 | apply (Finv_l f x H1). 134 | Qed. 135 | 136 | Lemma Finv_l_sym : forall (f : Field) (x : FT f), x <> (FO f) -> (FI f) = (Fmul f (Finv f x) x). 137 | Proof. 138 | move=> f x H1. 139 | rewrite (Finv_l f x H1). 140 | by []. 141 | Qed. 142 | 143 | Lemma Finv_r_sym : forall (f : Field) (x : FT f), x <> (FO f) -> (FI f) = (Fmul f x (Finv f x)). 144 | Proof. 145 | move=> f x H1. 146 | rewrite (Finv_r f x H1). 147 | by []. 148 | Qed. 149 | 150 | Lemma Fmul_O_r : forall (f : Field) (x : FT f), (Fmul f x (FO f)) = (FO f). 151 | Proof. 152 | move=> f x. 153 | apply (Fadd_O_r_uniq f (Fmul f x (FO f)) (Fmul f x (FO f))). 154 | rewrite - (Fmul_add_distr_l f x (FO f) (FO f)). 155 | rewrite (Fadd_O_l f (FO f)). 156 | by []. 157 | Qed. 158 | 159 | Lemma Fmul_O_l : forall (f : Field) (x : FT f), (Fmul f (FO f) x) = (FO f). 160 | Proof. 161 | move=> f x. 162 | rewrite (Fmul_comm f (FO f) x). 163 | apply (Fmul_O_r f x). 164 | Qed. 165 | 166 | Lemma Fmul_ne : forall (f : Field) (x : FT f), (Fmul f x (FI f)) = x /\ (Fmul f (FI f) x) = x. 167 | Proof. 168 | move=> f x. 169 | apply conj. 170 | rewrite (Fmul_comm f x (FI f)). 171 | apply (Fmul_I_l f x). 172 | apply (Fmul_I_l f x). 173 | Qed. 174 | 175 | Lemma Fmul_I_r : forall (f : Field) (x : FT f), (Fmul f x (FI f)) = x. 176 | Proof. 177 | move=> f x. 178 | rewrite (Fmul_comm f x (FI f)). 179 | apply (Fmul_I_l f x). 180 | Qed. 181 | 182 | Lemma Fmul_eq_compat_l : forall (f : Field) (x y z : FT f), y = z -> (Fmul f x y) = (Fmul f x z). 183 | Proof. 184 | move=> f x y z H1. 185 | rewrite H1. 186 | by []. 187 | Qed. 188 | 189 | Lemma Fmul_eq_compat_r : forall (f : Field) (x y z : FT f), y = z -> (Fmul f y x) = (Fmul f z x). 190 | Proof. 191 | move=> f x y z H1. 192 | rewrite H1. 193 | by []. 194 | Qed. 195 | 196 | Lemma Fmul_eq_reg_l : forall (f : Field) (x y z : FT f), (Fmul f x y) = (Fmul f x z) -> x <> (FO f) -> y = z. 197 | Proof. 198 | move=> f x y z H1 H2. 199 | rewrite - (Fmul_I_l f y). 200 | rewrite - (Fmul_I_l f z). 201 | rewrite - (Finv_l f x H2). 202 | rewrite (Fmul_assoc f (Finv f x) x y). 203 | rewrite (Fmul_assoc f (Finv f x) x z). 204 | rewrite H1. 205 | by []. 206 | Qed. 207 | 208 | Lemma Fmul_eq_reg_r : forall (f : Field) (x y z : FT f), (Fmul f y x) = (Fmul f z x) -> x <> (FO f) -> y = z. 209 | Proof. 210 | move=> f x y z H1 H2. 211 | rewrite - (Fmul_I_r f y). 212 | rewrite - (Fmul_I_r f z). 213 | rewrite - (Finv_r f x H2). 214 | rewrite - (Fmul_assoc f y x (Finv f x)). 215 | rewrite - (Fmul_assoc f z x (Finv f x)). 216 | rewrite H1. 217 | by []. 218 | Qed. 219 | 220 | Lemma Fmul_integral : forall (f : Field) (x y : FT f), (Fmul f x y) = (FO f) -> x = (FO f) \/ y = (FO f). 221 | Proof. 222 | move=> f x y H1. 223 | apply (NNPP (x = FO f \/ y = FO f)). 224 | move=> H2. 225 | apply H2. 226 | right. 227 | apply (Fmul_eq_reg_l f x y (FO f)). 228 | rewrite H1. 229 | rewrite (Fmul_O_r f x). 230 | by []. 231 | move=> H3. 232 | apply H2. 233 | left. 234 | apply H3. 235 | Qed. 236 | 237 | Lemma Fmul_eq_O_compat : forall (f : Field) (x y : FT f), (x = (FO f) \/ y = (FO f)) -> (Fmul f x y) = (FO f). 238 | Proof. 239 | move=> f x y H1. 240 | case H1. 241 | move=> H2. 242 | rewrite H2. 243 | apply (Fmul_O_l f y). 244 | move=> H2. 245 | rewrite H2. 246 | apply (Fmul_O_r f x). 247 | Qed. 248 | 249 | Lemma Fmul_eq_O_compat_r : forall (f : Field) (x y : FT f), x = (FO f) -> (Fmul f x y) = (FO f). 250 | Proof. 251 | move=> f x y H1. 252 | rewrite H1. 253 | apply (Fmul_O_l f y). 254 | Qed. 255 | 256 | Lemma Fmul_eq_O_compat_l : forall (f : Field) (x y : FT f), y = (FO f) -> (Fmul f x y) = (FO f). 257 | Proof. 258 | move=> f x y H1. 259 | rewrite H1. 260 | apply (Fmul_O_r f x). 261 | Qed. 262 | 263 | Lemma Fmul_neq_O_reg : forall (f : Field) (x y : FT f), (Fmul f x y) <> (FO f) -> x <> (FO f) /\ y <> (FO f). 264 | Proof. 265 | move=> f x y H1. 266 | apply conj. 267 | move=> H2. 268 | apply H1. 269 | rewrite H2. 270 | apply (Fmul_O_l f y). 271 | move=> H2. 272 | apply H1. 273 | rewrite H2. 274 | apply (Fmul_O_r f x). 275 | Qed. 276 | 277 | Lemma Fmul_integral_contrapositive : forall (f : Field) (x y : FT f), x <> (FO f) /\ y <> (FO f) -> (Fmul f x y) <> (FO f). 278 | Proof. 279 | move=> f x y H1. 280 | move=> H2. 281 | apply (proj1 H1). 282 | apply (Fmul_eq_reg_r f y x (FO f)). 283 | rewrite (Fmul_O_l f y). 284 | apply H2. 285 | apply (proj2 H1). 286 | Qed. 287 | 288 | Lemma Fmul_integral_contrapositive_currified : forall (f : Field) (x y : FT f), x <> (FO f) -> y <> (FO f) -> (Fmul f x y) <> (FO f). 289 | Proof. 290 | move=> f x y H1 H2. 291 | move=> H3. 292 | apply H1. 293 | apply (Fmul_eq_reg_r f y x (FO f)). 294 | rewrite (Fmul_O_l f y). 295 | apply H3. 296 | apply H2. 297 | Qed. 298 | 299 | Lemma Fmul_add_distr_r : forall (f : Field) (x y z : FT f), (Fmul f (Fadd f x y) z) = (Fadd f (Fmul f x z) (Fmul f y z)). 300 | Proof. 301 | move=> f x y z. 302 | rewrite (Fmul_comm f (Fadd f x y) z). 303 | rewrite (Fmul_add_distr_l f z x y). 304 | rewrite (Fmul_comm f x z). 305 | rewrite (Fmul_comm f y z). 306 | by []. 307 | Qed. 308 | 309 | Lemma Fopp_eq_compat : forall (f : Field) (x y : FT f), x = y -> (Fopp f x) = (Fopp f y). 310 | Proof. 311 | move=> f x y H1. 312 | rewrite H1. 313 | by []. 314 | Qed. 315 | 316 | Lemma Fopp_O : forall (f : Field), (Fopp f (FO f)) = (FO f). 317 | Proof. 318 | Proof. 319 | move=> f. 320 | apply (Fadd_O_r_uniq f (FO f) (Fopp f (FO f))). 321 | apply (Fadd_opp_r f (FO f)). 322 | Qed. 323 | 324 | Lemma Fopp_eq_O_compat : forall (f : Field) (x : FT f), x = (FO f) -> (Fopp f x) = (FO f). 325 | Proof. 326 | move=> f x H1. 327 | rewrite H1. 328 | apply (Fopp_O f). 329 | Qed. 330 | 331 | Lemma Fopp_involutive : forall (f : Field) (x : FT f), (Fopp f (Fopp f x)) = x. 332 | Proof. 333 | move=> f x. 334 | suff: x = Fopp f (Fopp f x). 335 | move=> H1. 336 | rewrite{2} H1. 337 | by []. 338 | apply (Fadd_opp_r_uniq f (Fopp f x)). 339 | apply (Fadd_opp_l f x). 340 | Qed. 341 | 342 | Lemma Fopp_neq_O_compat : forall (f : Field) (x : FT f), x <> (FO f) -> (Fopp f x) <> (FO f). 343 | Proof. 344 | move=> f x H1. 345 | move=> H2. 346 | apply H1. 347 | rewrite - (Fopp_involutive f x). 348 | apply (Fopp_eq_O_compat f (Fopp f x) H2). 349 | Qed. 350 | 351 | Lemma Fopp_add_distr : forall (f : Field) (x y : FT f), (Fopp f (Fadd f x y)) = (Fadd f (Fopp f x) (Fopp f y)). 352 | Proof. 353 | move=> f x y. 354 | suff: Fadd f (Fopp f x) (Fopp f y) = Fopp f (Fadd f x y). 355 | move=> H1. 356 | rewrite H1. 357 | by []. 358 | apply (Fadd_opp_r_uniq f (Fadd f x y)). 359 | rewrite (Fadd_comm f x y). 360 | rewrite - (Fadd_assoc f (Fadd f y x) (Fopp f x) (Fopp f y)). 361 | rewrite (Fadd_assoc f y x (Fopp f x)). 362 | rewrite (Fadd_opp_r f x). 363 | rewrite (Fadd_O_r f y). 364 | apply (Fadd_opp_r f y). 365 | Qed. 366 | 367 | Lemma Fopp_mul_distr_l : forall (f : Field) (x y : FT f), (Fopp f (Fmul f x y)) = (Fmul f (Fopp f x) y). 368 | Proof. 369 | move=> f x y. 370 | suff: Fmul f (Fopp f x) y = Fopp f (Fmul f x y). 371 | move=> H1. 372 | rewrite H1. 373 | by []. 374 | apply (Fadd_opp_r_uniq f (Fmul f x y)). 375 | rewrite - (Fmul_add_distr_r f x (Fopp f x) y). 376 | rewrite (Fadd_opp_r f x). 377 | apply (Fmul_O_l f y). 378 | Qed. 379 | 380 | Lemma Fopp_mul_distr_l_reverse : forall (f : Field) (x y : FT f), (Fmul f (Fopp f x) y) = (Fopp f (Fmul f x y)). 381 | Proof. 382 | move=> f x y. 383 | rewrite (Fopp_mul_distr_l f x y). 384 | reflexivity. 385 | Qed. 386 | 387 | Lemma Fopp_mul_distr_r : forall (f : Field) (x y : FT f), (Fopp f (Fmul f x y)) = (Fmul f x (Fopp f y)). 388 | Proof. 389 | move=> f x y. 390 | suff: Fmul f x (Fopp f y) = Fopp f (Fmul f x y). 391 | move=> H1. 392 | rewrite H1. 393 | by []. 394 | apply (Fadd_opp_r_uniq f (Fmul f x y)). 395 | rewrite - (Fmul_add_distr_l f x y (Fopp f y)). 396 | rewrite (Fadd_opp_r f y). 397 | apply (Fmul_O_r f x). 398 | Qed. 399 | 400 | Lemma Fopp_mul_distr_r_reverse : forall (f : Field) (x y : FT f), (Fmul f x (Fopp f y)) = (Fopp f (Fmul f x y)). 401 | Proof. 402 | move=> f x y. 403 | rewrite (Fopp_mul_distr_r f x y). 404 | reflexivity. 405 | Qed. 406 | 407 | Lemma Fmul_opp_opp : forall (f : Field) (x y : FT f), (Fmul f (Fopp f x) (Fopp f y)) = (Fmul f x y). 408 | Proof. 409 | move=> f x y. 410 | rewrite (Fopp_mul_distr_l_reverse f x (Fopp f y)). 411 | rewrite (Fopp_mul_distr_r_reverse f x y). 412 | apply (Fopp_involutive f (Fmul f x y)). 413 | Qed. 414 | 415 | Lemma Fminus_O_r : forall (f : Field) (x : FT f), (Fadd f x (Fopp f (FO f))) = x. 416 | Proof. 417 | move=> f x. 418 | rewrite (Fopp_O f). 419 | apply (Fadd_O_r f x). 420 | Qed. 421 | 422 | Lemma Fminus_O_l : forall (f : Field) (x : FT f), (Fadd f (FO f) (Fopp f x)) = (Fopp f x). 423 | Proof. 424 | move=> f x. 425 | apply (Fadd_O_l f (Fopp f x)). 426 | Qed. 427 | 428 | Lemma Fopp_minus_distr : forall (f : Field) (x y : FT f), (Fopp f (Fadd f x (Fopp f y))) = (Fadd f y (Fopp f x)). 429 | Proof. 430 | move=> f x y. 431 | rewrite (Fopp_add_distr f x (Fopp f y)). 432 | rewrite (Fopp_involutive f y). 433 | apply (Fadd_comm f (Fopp f x) y). 434 | Qed. 435 | 436 | Lemma Fopp_minus_distr' : forall (f : Field) (x y : FT f), (Fopp f (Fadd f y (Fopp f x))) = (Fadd f x (Fopp f y)). 437 | Proof. 438 | move=> f x y. 439 | rewrite (Fopp_add_distr f y (Fopp f x)). 440 | rewrite (Fopp_involutive f x). 441 | apply (Fadd_comm f (Fopp f y) x). 442 | Qed. 443 | 444 | Lemma Fminus_diag_eq : forall (f : Field) (x y : FT f), x = y -> (Fadd f x (Fopp f y)) = (FO f). 445 | Proof. 446 | move=> f x y H1. 447 | rewrite H1. 448 | apply (Fadd_opp_r f y). 449 | Qed. 450 | 451 | Lemma Fminus_diag_uniq : forall (f : Field) (x y : FT f), (Fadd f x (Fopp f y)) = (FO f) -> x = y. 452 | Proof. 453 | move=> f x y H1. 454 | rewrite<- (Fadd_O_r f x). 455 | rewrite<- (Fadd_opp_l f y). 456 | rewrite<- (Fadd_O_l f y) at 3. 457 | rewrite<- (Fadd_assoc f x (Fopp f y) y). 458 | rewrite H1. 459 | reflexivity. 460 | Qed. 461 | 462 | Lemma Fminus_diag_uniq_sym : forall (f : Field) (x y : FT f), (Fadd f y (Fopp f x)) = (FO f) -> x = y. 463 | Proof. 464 | move=> f x y H1. 465 | rewrite (Fminus_diag_uniq f y x H1). 466 | reflexivity. 467 | Qed. 468 | 469 | Lemma Fadd_minus : forall (f : Field) (x y : FT f), (Fadd f x (Fadd f y (Fopp f x))) = y. 470 | Proof. 471 | move=> f x y. 472 | rewrite (Fadd_comm f y (Fopp f x)). 473 | rewrite<- (Fadd_assoc f x (Fopp f x) y). 474 | rewrite (Fadd_opp_r f x). 475 | apply (Fadd_O_l f y). 476 | Qed. 477 | 478 | Lemma Fminus_eq_contra : forall (f : Field) (x y : FT f), x <> y -> (Fadd f x (Fopp f y)) <> (FO f). 479 | Proof. 480 | move=> f x y H1 H2. 481 | apply H1. 482 | apply (Fminus_diag_uniq f x y H2). 483 | Qed. 484 | 485 | Lemma Fminus_not_eq : forall (f : Field) (x y : FT f), (Fadd f x (Fopp f y)) <> (FO f) -> x <> y. 486 | Proof. 487 | move=> f x y H1 H2. 488 | apply H1. 489 | apply (Fminus_diag_eq f x y H2). 490 | Qed. 491 | 492 | Lemma Fminus_not_eq_right : forall (f : Field) (x y : FT f), (Fadd f y (Fopp f x)) <> (FO f) -> x <> y. 493 | Proof. 494 | move=> f x y H1 H2. 495 | apply H1. 496 | apply (Fminus_diag_eq f y x). 497 | rewrite H2. 498 | reflexivity. 499 | Qed. 500 | 501 | Lemma Fmul_minus_distr_l : forall (f : Field) (x y z : FT f), (Fmul f x (Fadd f y (Fopp f z))) = (Fadd f (Fmul f x y) (Fopp f (Fmul f x z))). 502 | Proof. 503 | move=> f x y z. 504 | rewrite (Fmul_add_distr_l f x y (Fopp f z)). 505 | rewrite (Fopp_mul_distr_r f x z). 506 | reflexivity. 507 | Qed. 508 | 509 | Lemma Fmul_inv_r_uniq : forall (f : Field) (x y : FT f), (Fmul f x y) = (FI f) -> y = (Finv f x). 510 | Proof. 511 | move=> f. 512 | elim (classic ((FO f) = (FI f))). 513 | move=> H1. 514 | suff: (forall (x : FT f), x = (FO f)). 515 | move=> H2 x y H3. 516 | rewrite (H2 (Finv f x)). 517 | apply (H2 y). 518 | move=> x. 519 | rewrite<- (Fmul_O_r f x). 520 | rewrite H1. 521 | rewrite (Fmul_I_r f x). 522 | reflexivity. 523 | move=> H1 x y H2. 524 | suff: (x <> (FO f)). 525 | move=> H3. 526 | rewrite<- (Fmul_I_l f y). 527 | rewrite<- (Finv_l f x H3). 528 | rewrite (Fmul_assoc f (Finv f x) x y). 529 | rewrite H2. 530 | apply (Fmul_I_r f (Finv f x)). 531 | move=> H3. 532 | apply H1. 533 | rewrite<- H2. 534 | rewrite H3. 535 | rewrite (Fmul_O_l f y). 536 | reflexivity. 537 | Qed. 538 | 539 | Lemma Finv_1 : forall (f : Field), (Finv f (FI f)) = (FI f). 540 | Proof. 541 | move=> f. 542 | rewrite{2} (Fmul_inv_r_uniq f (FI f) (FI f)). 543 | reflexivity. 544 | apply (Fmul_I_r f (FI f)). 545 | Qed. 546 | 547 | Lemma Finv_neq_O_compat : forall (f : Field) (x : FT f), x <> (FO f) -> (Finv f x) <> (FO f). 548 | Proof. 549 | move=> f. 550 | elim (classic ((FO f) = (FI f))). 551 | move=> H1. 552 | suff: (forall (x : FT f), x = (FO f)). 553 | move=> H2 x H3 H4. 554 | apply H3. 555 | apply (H2 x). 556 | move=> x. 557 | rewrite<- (Fmul_O_r f x). 558 | rewrite H1. 559 | rewrite (Fmul_I_r f x). 560 | reflexivity. 561 | move=> H1 x H2 H3. 562 | apply H1. 563 | rewrite (Finv_r_sym f x H2). 564 | rewrite H3. 565 | rewrite (Fmul_O_r f x). 566 | reflexivity. 567 | Qed. 568 | 569 | Lemma Finv_involutive : forall (f : Field) (x : FT f), x <> (FO f) -> (Finv f (Finv f x)) = x. 570 | Proof. 571 | move=> f x H1. 572 | rewrite{2} (Fmul_inv_r_uniq f (Finv f x) x). 573 | reflexivity. 574 | apply (Finv_l f x H1). 575 | Qed. 576 | 577 | Lemma Finv_mul_distr : forall (f : Field) (x y : FT f), x <> (FO f) -> y <> (FO f) -> (Finv f (Fmul f x y)) = (Fmul f (Finv f x) (Finv f y)). 578 | Proof. 579 | move=> f x y H1 H2. 580 | rewrite (Fmul_inv_r_uniq f (Fmul f x y) (Fmul f (Finv f x) (Finv f y))). 581 | reflexivity. 582 | rewrite (Fmul_comm f x y). 583 | rewrite - (Fmul_assoc f (Fmul f y x) (Finv f x) (Finv f y)). 584 | rewrite (Fmul_assoc f y x (Finv f x)). 585 | rewrite (Finv_r f x H1). 586 | rewrite (Fmul_I_r f y). 587 | apply (Finv_r f y H2). 588 | Qed. 589 | 590 | Lemma Fopp_inv_permute : forall (f : Field) (x : FT f), x <> (FO f) -> (Fopp f (Finv f x)) = (Finv f (Fopp f x)). 591 | Proof. 592 | move=> f x H1. 593 | rewrite (Fmul_inv_r_uniq f (Fopp f x) (Fopp f (Finv f x))). 594 | reflexivity. 595 | rewrite (Fmul_opp_opp f x (Finv f x)). 596 | apply (Finv_r f x H1). 597 | Qed. 598 | 599 | Lemma Finv_r_simpl_r : forall (f : Field) (x y : FT f), x <> (FO f) -> (Fmul f (Fmul f x (Finv f x)) y) = y. 600 | Proof. 601 | move=> f x y H1. 602 | rewrite (Finv_r f x H1). 603 | rewrite (Fmul_I_l f y). 604 | reflexivity. 605 | Qed. 606 | 607 | Lemma Finv_r_simpl_l : forall (f : Field) (x y : FT f), x <> (FO f) -> (Fmul f (Fmul f y x) (Finv f x)) = y. 608 | Proof. 609 | move=> f x y H1. 610 | rewrite (Fmul_assoc f y x (Finv f x)). 611 | rewrite (Finv_r f x H1). 612 | apply (Fmul_I_r f y). 613 | Qed. 614 | 615 | Lemma Finv_r_simpl_m : forall (f : Field) (x y : FT f), x <> (FO f) -> (Fmul f (Fmul f x y) (Finv f x)) = y. 616 | Proof. 617 | move=> f x y H1. 618 | rewrite (Fmul_comm f x y). 619 | rewrite (Fmul_assoc f y x (Finv f x)). 620 | rewrite (Finv_r f x H1). 621 | apply (Fmul_I_r f y). 622 | Qed. 623 | 624 | Lemma Finv_mult_simpl : forall (f : Field) (x y z : FT f), x <> (FO f) -> (Fmul f (Fmul f x (Finv f y)) (Fmul f z (Finv f x))) = (Fmul f z (Finv f y)). 625 | Proof. 626 | move=> f x y z H1. 627 | rewrite (Fmul_comm f (Fmul f x (Finv f y)) (Fmul f z (Finv f x))). 628 | rewrite (Fmul_assoc f z (Finv f x) (Fmul f x (Finv f y))). 629 | rewrite - (Fmul_assoc f (Finv f x) x (Finv f y)). 630 | rewrite (Finv_l f x H1). 631 | rewrite (Fmul_I_l f (Finv f y)). 632 | reflexivity. 633 | Qed. 634 | 635 | Fixpoint PowF (f : Field) (x : FT f) (N : nat) := match N with 636 | | O => FI f 637 | | S n => Fmul f (PowF f x n) x 638 | end. 639 | 640 | Definition NatCorrespondField := fun (f : Field) => (fix NatCorrespond (n : nat) : FT f := match n with 641 | | O => FO f 642 | | S n0 => (Fadd f (NatCorrespond n0) (FI f)) 643 | end). 644 | 645 | Definition CharacteristicField := fun (f : Field) => (match excluded_middle_informative (Inhabited nat (fun (n : nat) => NatCorrespondField f (S n) = FO f)) with 646 | | left H => S (proj1_sig (min_nat_get (fun (n : nat) => NatCorrespondField f (S n) = FO f) H)) 647 | | right _ => O 648 | end). 649 | 650 | Definition FPCM (f : Field) := mkCommutativeMonoid (FT f) (FO f) (Fadd f) (Fadd_comm f) (Fadd_O_r f) (Fadd_assoc f). 651 | 652 | Definition FMCM (f : Field) := mkCommutativeMonoid (FT f) (FI f) (Fmul f) (Fmul_comm f) (Fmul_I_r f) (Fmul_assoc f). 653 | 654 | End Field. 655 | -------------------------------------------------------------------------------- /MyAlgebraicStructure/MyVectorSpace.v: -------------------------------------------------------------------------------- 1 | Add LoadPath "MyAlgebraicStructure" as MyAlgebraicStructure. 2 | Add LoadPath "BasicProperty" as BasicProperty. 3 | Add LoadPath "Tools" as Tools. 4 | 5 | From mathcomp Require Import ssreflect. 6 | Require Import Classical. 7 | Require Import Coq.Logic.FunctionalExtensionality. 8 | Require Import MyAlgebraicStructure.MyField. 9 | Require Import BasicProperty.MappingProperty. 10 | 11 | Section VectorSpace. 12 | 13 | Record VectorSpace (F : Field) : Type := mkVectorSpace 14 | { 15 | VT : Type; 16 | VO : VT; 17 | Vadd : VT -> VT -> VT; 18 | Vmul : (FT F) -> VT -> VT; 19 | Vopp : VT -> VT; 20 | Vadd_comm : forall (x y : VT), (Vadd x y) = (Vadd y x); 21 | Vadd_assoc : forall (x y z : VT), (Vadd (Vadd x y) z) = (Vadd x (Vadd y z)); 22 | Vadd_O_l : forall x : VT, (Vadd VO x) = x; 23 | Vadd_opp_r : forall x : VT, (Vadd x (Vopp x)) = VO; 24 | Vmul_add_distr_l : forall (x : FT F) (y z : VT), (Vmul x (Vadd y z)) = (Vadd (Vmul x y) (Vmul x z)); 25 | Vmul_add_distr_r : forall (x y : FT F) (z : VT), (Vmul (Fadd F x y) z) = (Vadd (Vmul x z) (Vmul y z)); 26 | Vmul_assoc : forall (x y : FT F) (z : VT), (Vmul x (Vmul y z)) = (Vmul (Fmul F x y) z); 27 | Vmul_I_l : forall x : VT, (Vmul (FI F) x) = x; 28 | }. 29 | 30 | Lemma Vadd_O_r : forall (F : Field) (v : VectorSpace F) (x : VT F v), (Vadd F v x (VO F v)) = x. 31 | Proof. 32 | move=> F v x. 33 | rewrite (Vadd_comm F v x (VO F v)). 34 | apply (Vadd_O_l F v x). 35 | Qed. 36 | 37 | Lemma Vadd_ne : forall (F : Field) (v : VectorSpace F) (x : VT F v), (Vadd F v x (VO F v)) = x /\ (Vadd F v (VO F v) x) = x. 38 | Proof. 39 | move=> F v x. 40 | apply conj. 41 | apply (Vadd_O_r F v x). 42 | apply (Vadd_O_l F v x). 43 | Qed. 44 | 45 | Lemma Vadd_opp_l : forall (F : Field) (v : VectorSpace F) (x : VT F v), (Vadd F v (Vopp F v x) x) = (VO F v). 46 | Proof. 47 | move=> F v x. 48 | rewrite (Vadd_comm F v (Vopp F v x) x). 49 | apply (Vadd_opp_r F v x). 50 | Qed. 51 | 52 | Lemma Vadd_opp_r_uniq : forall (F : Field) (v : VectorSpace F) (x y : VT F v), (Vadd F v x y) = (VO F v) -> y = (Vopp F v x). 53 | Proof. 54 | move=> F v x y H1. 55 | suff: (Vadd F v (Vopp F v x) (Vadd F v x y)) = (Vadd F v (Vopp F v x) (VO F v)). 56 | move=> H2. 57 | rewrite - (Vadd_O_r F v (Vopp F v x)). 58 | rewrite - H2. 59 | rewrite - (Vadd_assoc F v (Vopp F v x) x y). 60 | rewrite (Vadd_opp_l F v x). 61 | rewrite (Vadd_O_l F v y). 62 | by []. 63 | rewrite H1. 64 | by []. 65 | Qed. 66 | 67 | Lemma Vadd_eq_compat_l : forall (F : Field) (v : VectorSpace F) (x y z : VT F v), y = z -> (Vadd F v x y) = (Vadd F v x z). 68 | Proof. 69 | move=> F v x y z H1. 70 | rewrite H1. 71 | by []. 72 | Qed. 73 | 74 | Lemma Vadd_eq_compat_r : forall (F : Field) (v : VectorSpace F) (x y z : VT F v), y = z -> (Vadd F v y x) = (Vadd F v z x). 75 | Proof. 76 | move=> F v x y z H1. 77 | rewrite H1. 78 | by []. 79 | Qed. 80 | 81 | Lemma Vadd_eq_reg_l : forall (F : Field) (v : VectorSpace F) (x y z : VT F v), (Vadd F v x y) = (Vadd F v x z) -> y = z. 82 | Proof. 83 | move=> F v x y z H1. 84 | rewrite - (Vadd_O_l F v y). 85 | rewrite - (Vadd_O_l F v z). 86 | rewrite - (Vadd_opp_l F v x). 87 | rewrite (Vadd_assoc F v (Vopp F v x) x y). 88 | rewrite (Vadd_assoc F v (Vopp F v x) x z). 89 | apply (Vadd_eq_compat_l F v (Vopp F v x) (Vadd F v x y) (Vadd F v x z)). 90 | by []. 91 | Qed. 92 | 93 | Lemma Vadd_eq_reg_r : forall (F : Field) (v : VectorSpace F) (x y z : VT F v), (Vadd F v y x) = (Vadd F v z x) -> y = z. 94 | Proof. 95 | move=> F v x y z H1. 96 | rewrite - (Vadd_O_r F v y). 97 | rewrite - (Vadd_O_r F v z). 98 | rewrite - (Vadd_opp_r F v x). 99 | rewrite - (Vadd_assoc F v y x (Vopp F v x)). 100 | rewrite - (Vadd_assoc F v z x (Vopp F v x)). 101 | apply (Vadd_eq_compat_r F v (Vopp F v x) (Vadd F v y x) (Vadd F v z x)). 102 | by []. 103 | Qed. 104 | 105 | Lemma Vadd_O_r_uniq : forall (F : Field) (v : VectorSpace F) (x y : VT F v), (Vadd F v x y) = x -> y = (VO F v). 106 | Proof. 107 | move=> F v x y H1. 108 | rewrite - (Vadd_O_l F v y). 109 | rewrite - (Vadd_opp_l F v x). 110 | rewrite (Vadd_assoc F v (Vopp F v x) x y). 111 | rewrite H1. 112 | by []. 113 | Qed. 114 | 115 | Lemma Vmul_O_r : forall (F : Field) (v : VectorSpace F) (x : FT F), (Vmul F v x (VO F v)) = (VO F v). 116 | Proof. 117 | move=> F v x. 118 | apply (Vadd_O_r_uniq F v (Vmul F v x (VO F v)) (Vmul F v x (VO F v))). 119 | rewrite - (Vmul_add_distr_l F v x (VO F v) (VO F v)). 120 | rewrite (Vadd_O_l F v (VO F v)). 121 | by []. 122 | Qed. 123 | 124 | Lemma Vmul_O_l : forall (F : Field) (v : VectorSpace F) (x : VT F v), (Vmul F v (FO F) x) = (VO F v). 125 | Proof. 126 | move=> F v x. 127 | apply (Vadd_O_r_uniq F v (Vmul F v (FO F) x) (Vmul F v (FO F) x)). 128 | rewrite - (Vmul_add_distr_r F v (FO F) (FO F) x). 129 | rewrite (Fadd_O_l F (FO F)). 130 | by []. 131 | Qed. 132 | 133 | Lemma Vmul_eq_compat_l : forall (F : Field) (v : VectorSpace F) (x : FT F) (y z : VT F v), y = z -> (Vmul F v x y) = (Vmul F v x z). 134 | Proof. 135 | move=> F v x y z H1. 136 | rewrite H1. 137 | by []. 138 | Qed. 139 | 140 | Lemma Vmul_eq_compat_r : forall (F : Field) (v : VectorSpace F) (x : VT F v) (y z : FT F), y = z -> (Vmul F v y x) = (Vmul F v z x). 141 | Proof. 142 | move=> F v x y z H1. 143 | rewrite H1. 144 | by []. 145 | Qed. 146 | 147 | Lemma Vmul_eq_reg_l : forall (F : Field) (v : VectorSpace F) (x : FT F) (y z : VT F v), (Vmul F v x y) = (Vmul F v x z) -> x <> (FO F) -> y = z. 148 | Proof. 149 | move=> F v x y z H1 H2. 150 | rewrite - (Vmul_I_l F v y). 151 | rewrite - (Vmul_I_l F v z). 152 | rewrite - (Finv_l F x H2). 153 | rewrite - (Vmul_assoc F v (Finv F x) x y). 154 | rewrite - (Vmul_assoc F v (Finv F x) x z). 155 | rewrite H1. 156 | by []. 157 | Qed. 158 | 159 | Lemma Vmul_eq_reg_r : forall (F : Field) (v : VectorSpace F) (x : VT F v) (y z : FT F), (Vmul F v y x) = (Vmul F v z x) -> x <> (VO F v) -> y = z. 160 | Proof. 161 | move=> F v x y z H1 H2. 162 | apply NNPP. 163 | move=> H3. 164 | apply H2. 165 | rewrite - (Vmul_I_l F v x). 166 | rewrite - (Finv_l F (Fadd F y (Fopp F z))). 167 | rewrite - (Vmul_assoc F v (Finv F (Fadd F y (Fopp F z))) (Fadd F y (Fopp F z)) x). 168 | suff: ((Vmul F v (Fadd F y (Fopp F z)) x) = VO F v). 169 | move=> H4. 170 | rewrite H4. 171 | apply (Vmul_O_r F v (Finv F (Fadd F y (Fopp F z)))). 172 | apply (Vadd_eq_reg_r F v (Vmul F v z x) (Vmul F v (Fadd F y (Fopp F z)) x) (VO F v)). 173 | rewrite (Vadd_O_l F v (Vmul F v z x)). 174 | rewrite (Vmul_add_distr_r F v y (Fopp F z) x). 175 | rewrite (Vadd_assoc F v (Vmul F v y x) (Vmul F v (Fopp F z) x) (Vmul F v z x)). 176 | rewrite - (Vmul_add_distr_r F v (Fopp F z) z x). 177 | rewrite (Fadd_opp_l F z). 178 | rewrite (Vmul_O_l F v x). 179 | rewrite H1. 180 | apply (Vadd_O_r F v (Vmul F v z x)). 181 | move=> H4. 182 | apply H3. 183 | apply (Fminus_diag_uniq F y z H4). 184 | Qed. 185 | 186 | Lemma Vmul_integral : forall (F : Field) (v : VectorSpace F) (x : FT F) (y : VT F v), (Vmul F v x y) = (VO F v) -> x = (FO F) \/ y = (VO F v). 187 | Proof. 188 | move=> F v x y H1. 189 | apply (NNPP (x = FO F \/ y = VO F v)). 190 | move=> H2. 191 | apply H2. 192 | right. 193 | apply (Vmul_eq_reg_l F v x y (VO F v)). 194 | rewrite H1. 195 | rewrite (Vmul_O_r F v x). 196 | by []. 197 | move=> H3. 198 | apply H2. 199 | left. 200 | apply H3. 201 | Qed. 202 | 203 | Lemma Vmul_eq_O_compat : forall (F : Field) (v : VectorSpace F) (x : FT F) (y : VT F v), (x = (FO F) \/ y = (VO F v)) -> (Vmul F v x y) = (VO F v). 204 | Proof. 205 | move=> F v x y H1. 206 | case H1. 207 | move=> H2. 208 | rewrite H2. 209 | apply (Vmul_O_l F v y). 210 | move=> H2. 211 | rewrite H2. 212 | apply (Vmul_O_r F v x). 213 | Qed. 214 | 215 | Lemma Vmul_eq_O_compat_r : forall (F : Field) (v : VectorSpace F) (x : FT F) (y : VT F v), x = (FO F) -> (Vmul F v x y) = (VO F v). 216 | Proof. 217 | move=> F v x y H1. 218 | rewrite H1. 219 | apply (Vmul_O_l F v y). 220 | Qed. 221 | 222 | Lemma Vmul_eq_O_compat_l : forall (F : Field) (v : VectorSpace F) (x : FT F) (y : VT F v), y = (VO F v) -> (Vmul F v x y) = (VO F v). 223 | Proof. 224 | move=> F v x y H1. 225 | rewrite H1. 226 | apply (Vmul_O_r F v x). 227 | Qed. 228 | 229 | Lemma Vmul_neq_O_reg : forall (F : Field) (v : VectorSpace F) (x : FT F) (y : VT F v), (Vmul F v x y) <> (VO F v) -> x <> (FO F) /\ y <> (VO F v). 230 | Proof. 231 | move=> F v x y H1. 232 | apply conj. 233 | move=> H2. 234 | apply H1. 235 | rewrite H2. 236 | apply (Vmul_O_l F v y). 237 | move=> H2. 238 | apply H1. 239 | rewrite H2. 240 | apply (Vmul_O_r F v x). 241 | Qed. 242 | 243 | Lemma Vmul_integral_contrapositive : forall (F : Field) (v : VectorSpace F) (x : FT F) (y : VT F v), x <> (FO F) /\ y <> (VO F v) -> (Vmul F v x y) <> (VO F v). 244 | Proof. 245 | move=> F v x y H1 H2. 246 | apply (proj1 H1). 247 | apply (Vmul_eq_reg_r F v y x (FO F)). 248 | rewrite (Vmul_O_l F v y). 249 | apply H2. 250 | apply (proj2 H1). 251 | Qed. 252 | 253 | Lemma Vmul_integral_contrapositive_currified : forall (F : Field) (v : VectorSpace F) (x : FT F) (y : VT F v), x <> (FO F) -> y <> (VO F v) -> (Vmul F v x y) <> (VO F v). 254 | Proof. 255 | move=> F v x y H1 H2 H3. 256 | apply H1. 257 | apply (Vmul_eq_reg_r F v y x (FO F)). 258 | rewrite (Vmul_O_l F v y). 259 | apply H3. 260 | apply H2. 261 | Qed. 262 | 263 | Lemma Vopp_eq_compat : forall (F : Field) (v : VectorSpace F) (x y : VT F v), x = y -> (Vopp F v x) = (Vopp F v y). 264 | Proof. 265 | move=> F v x y H1. 266 | rewrite H1. 267 | by []. 268 | Qed. 269 | 270 | Lemma Vopp_O : forall (F : Field) (v : VectorSpace F), (Vopp F v (VO F v)) = (VO F v). 271 | Proof. 272 | move=> F v. 273 | apply (Vadd_O_r_uniq F v (VO F v) (Vopp F v (VO F v))). 274 | apply (Vadd_opp_r F v (VO F v)). 275 | Qed. 276 | 277 | Lemma Vopp_eq_O_compat : forall (F : Field) (v : VectorSpace F) (x : VT F v), x = (VO F v) -> (Vopp F v x) = (VO F v). 278 | Proof. 279 | move=> F v x H1. 280 | rewrite H1. 281 | apply (Vopp_O F v). 282 | Qed. 283 | 284 | Lemma Vopp_involutive : forall (F : Field) (v : VectorSpace F) (x : VT F v), (Vopp F v (Vopp F v x)) = x. 285 | Proof. 286 | move=> F v x. 287 | suff: x = Vopp F v (Vopp F v x). 288 | move=> H1. 289 | rewrite{2} H1. 290 | by []. 291 | apply (Vadd_opp_r_uniq F v (Vopp F v x)). 292 | apply (Vadd_opp_l F v x). 293 | Qed. 294 | 295 | Lemma Vopp_neq_O_compat : forall (F : Field) (v : VectorSpace F) (x : VT F v), x <> (VO F v) -> (Vopp F v x) <> (VO F v). 296 | Proof. 297 | move=> F v x H1 H2. 298 | apply H1. 299 | rewrite - (Vopp_involutive F v x). 300 | apply (Vopp_eq_O_compat F v (Vopp F v x) H2). 301 | Qed. 302 | 303 | Lemma Vopp_add_distr : forall (F : Field) (v : VectorSpace F) (x y : VT F v), (Vopp F v (Vadd F v x y)) = (Vadd F v (Vopp F v x) (Vopp F v y)). 304 | Proof. 305 | move=> F v x y. 306 | suff: Vadd F v (Vopp F v x) (Vopp F v y) = Vopp F v (Vadd F v x y). 307 | move=> H1. 308 | rewrite H1. 309 | by []. 310 | apply (Vadd_opp_r_uniq F v (Vadd F v x y)). 311 | rewrite (Vadd_comm F v x y). 312 | rewrite - (Vadd_assoc F v (Vadd F v y x) (Vopp F v x) (Vopp F v y)). 313 | rewrite (Vadd_assoc F v y x (Vopp F v x)). 314 | rewrite (Vadd_opp_r F v x). 315 | rewrite (Vadd_O_r F v y). 316 | apply (Vadd_opp_r F v y). 317 | Qed. 318 | 319 | Lemma Vopp_mul_distr_l : forall (F : Field) (v : VectorSpace F) (x : FT F) (y : VT F v), (Vopp F v (Vmul F v x y)) = (Vmul F v (Fopp F x) y). 320 | Proof. 321 | move=> F v x y. 322 | suff: Vmul F v (Fopp F x) y = Vopp F v (Vmul F v x y). 323 | move=> H1. 324 | rewrite H1. 325 | by []. 326 | apply (Vadd_opp_r_uniq F v (Vmul F v x y)). 327 | rewrite - (Vmul_add_distr_r F v x (Fopp F x) y). 328 | rewrite (Fadd_opp_r F x). 329 | apply (Vmul_O_l F v y). 330 | Qed. 331 | 332 | Lemma Vopp_mul_distr_l_reverse : forall (F : Field) (v : VectorSpace F) (x : FT F) (y : VT F v), (Vmul F v (Fopp F x) y) = (Vopp F v (Vmul F v x y)). 333 | Proof. 334 | move=> F v x y. 335 | rewrite (Vopp_mul_distr_l F v x y). 336 | reflexivity. 337 | Qed. 338 | 339 | Lemma Vopp_mul_distr_r : forall (F : Field) (v : VectorSpace F) (x : FT F) (y : VT F v), (Vopp F v (Vmul F v x y)) = (Vmul F v x (Vopp F v y)). 340 | Proof. 341 | move=> F v x y. 342 | suff: Vmul F v x (Vopp F v y) = Vopp F v (Vmul F v x y). 343 | move=> H1. 344 | rewrite H1. 345 | by []. 346 | apply (Vadd_opp_r_uniq F v (Vmul F v x y)). 347 | rewrite - (Vmul_add_distr_l F v x y (Vopp F v y)). 348 | rewrite (Vadd_opp_r F v y). 349 | apply (Vmul_O_r F v x). 350 | Qed. 351 | 352 | Lemma Vopp_mul_distr_r_reverse : forall (F : Field) (v : VectorSpace F) (x : FT F) (y : VT F v), (Vmul F v x (Vopp F v y)) = (Vopp F v (Vmul F v x y)). 353 | Proof. 354 | move=> F v x y. 355 | rewrite (Vopp_mul_distr_r F v x y). 356 | reflexivity. 357 | Qed. 358 | 359 | Lemma Vmul_opp_opp : forall (F : Field) (v : VectorSpace F) (x : FT F) (y : VT F v), (Vmul F v (Fopp F x) (Vopp F v y)) = (Vmul F v x y). 360 | Proof. 361 | move=> F v x y. 362 | rewrite (Vopp_mul_distr_l_reverse F v x (Vopp F v y)). 363 | rewrite (Vopp_mul_distr_r_reverse F v x y). 364 | apply (Vopp_involutive F v (Vmul F v x y)). 365 | Qed. 366 | 367 | Lemma Vminus_O_r : forall (F : Field) (v : VectorSpace F) (x : VT F v), (Vadd F v x (Vopp F v (VO F v))) = x. 368 | Proof. 369 | move=> F v x. 370 | rewrite (Vopp_O F v). 371 | apply (Vadd_O_r F v x). 372 | Qed. 373 | 374 | Lemma Vminus_O_l : forall (F : Field) (v : VectorSpace F) (x : VT F v), (Vadd F v (VO F v) (Vopp F v x)) = (Vopp F v x). 375 | Proof. 376 | move=> F v x. 377 | apply (Vadd_O_l F v (Vopp F v x)). 378 | Qed. 379 | 380 | Lemma Vopp_minus_distr : forall (F : Field) (v : VectorSpace F) (x y : VT F v), (Vopp F v (Vadd F v x (Vopp F v y))) = (Vadd F v y (Vopp F v x)). 381 | Proof. 382 | move=> F v x y. 383 | rewrite (Vopp_add_distr F v x (Vopp F v y)). 384 | rewrite (Vopp_involutive F v y). 385 | apply (Vadd_comm F v (Vopp F v x) y). 386 | Qed. 387 | 388 | Lemma Vopp_minus_distr' : forall (F : Field) (v : VectorSpace F) (x y : VT F v), (Vopp F v (Vadd F v y (Vopp F v x))) = (Vadd F v x (Vopp F v y)). 389 | Proof. 390 | move=> F v x y. 391 | rewrite (Vopp_add_distr F v y (Vopp F v x)). 392 | rewrite (Vopp_involutive F v x). 393 | apply (Vadd_comm F v (Vopp F v y) x). 394 | Qed. 395 | 396 | Lemma Vminus_diag_eq : forall (F : Field) (v : VectorSpace F) (x y : VT F v), x = y -> (Vadd F v x (Vopp F v y)) = (VO F v). 397 | Proof. 398 | move=> F v x y H1. 399 | rewrite H1. 400 | apply (Vadd_opp_r F v y). 401 | Qed. 402 | 403 | Lemma Vminus_diag_uniq : forall (F : Field) (v : VectorSpace F) (x y : VT F v), (Vadd F v x (Vopp F v y)) = (VO F v) -> x = y. 404 | Proof. 405 | move=> F v x y H1. 406 | rewrite<- (Vadd_O_r F v x). 407 | rewrite<- (Vadd_opp_l F v y). 408 | rewrite<- (Vadd_O_l F v y) at 3. 409 | rewrite<- (Vadd_assoc F v x (Vopp F v y) y). 410 | rewrite H1. 411 | reflexivity. 412 | Qed. 413 | 414 | Lemma Vminus_diag_uniq_sym : forall (F : Field) (v : VectorSpace F) (x y : VT F v), (Vadd F v y (Vopp F v x)) = (VO F v) -> x = y. 415 | Proof. 416 | move=> F v x y H1. 417 | rewrite (Vminus_diag_uniq F v y x H1). 418 | reflexivity. 419 | Qed. 420 | 421 | Lemma Vadd_minus : forall (F : Field) (v : VectorSpace F) (x y : VT F v), (Vadd F v x (Vadd F v y (Vopp F v x))) = y. 422 | Proof. 423 | move=> F v x y. 424 | rewrite (Vadd_comm F v y (Vopp F v x)). 425 | rewrite<- (Vadd_assoc F v x (Vopp F v x) y). 426 | rewrite (Vadd_opp_r F v x). 427 | apply (Vadd_O_l F v y). 428 | Qed. 429 | 430 | Lemma Vminus_eq_contra : forall (F : Field) (v : VectorSpace F) (x y : VT F v), x <> y -> (Vadd F v x (Vopp F v y)) <> (VO F v). 431 | Proof. 432 | move=> F v x y H1 H2. 433 | apply H1. 434 | apply (Vminus_diag_uniq F v x y H2). 435 | Qed. 436 | 437 | Lemma Vminus_not_eq : forall (F : Field) (v : VectorSpace F) (x y : VT F v), (Vadd F v x (Vopp F v y)) <> (VO F v) -> x <> y. 438 | Proof. 439 | move=> F v x y H1 H2. 440 | apply H1. 441 | apply (Vminus_diag_eq F v x y H2). 442 | Qed. 443 | 444 | Lemma Vminus_not_eq_right : forall (F : Field) (v : VectorSpace F) (x y : VT F v), (Vadd F v y (Vopp F v x)) <> (VO F v) -> x <> y. 445 | Proof. 446 | move=> F v x y H1 H2. 447 | apply H1. 448 | apply (Vminus_diag_eq F v y x). 449 | rewrite H2. 450 | reflexivity. 451 | Qed. 452 | 453 | Lemma Vmul_minus_distr_l : forall (F : Field) (v : VectorSpace F) (x : FT F) (y z : VT F v), (Vmul F v x (Vadd F v y (Vopp F v z))) = (Vadd F v (Vmul F v x y) (Vopp F v (Vmul F v x z))). 454 | Proof. 455 | move=> F v x y z. 456 | rewrite (Vmul_add_distr_l F v x y (Vopp F v z)). 457 | rewrite (Vopp_mul_distr_r F v x z). 458 | reflexivity. 459 | Qed. 460 | 461 | Definition IsomorphicVS (F : Field) (v1 v2 : VectorSpace F) (f : VT F v1 -> VT F v2) := Bijective f /\ (forall (x y : VT F v1), f (Vadd F v1 x y) = Vadd F v2 (f x) (f y)) /\ (forall (c : FT F) (x : VT F v1), f (Vmul F v1 c x) = Vmul F v2 c (f x)). 462 | 463 | Lemma IsomorphicChainVS : forall (F : Field) (v1 v2 v3 : VectorSpace F) (f : VT F v1 -> VT F v2) (g : VT F v2 -> VT F v3), IsomorphicVS F v1 v2 f -> IsomorphicVS F v2 v3 g -> IsomorphicVS F v1 v3 (fun (x : VT F v1) => g (f x)). 464 | Proof. 465 | move=> F v1 v2 v3 f g H1 H2. 466 | apply conj. 467 | apply (BijChain (VT F v1) (VT F v2) (VT F v3) f g (proj1 H1) (proj1 H2)). 468 | apply conj. 469 | move=> x y. 470 | rewrite ((proj1 (proj2 H1)) x y). 471 | apply ((proj1 (proj2 H2)) (f x) (f y)). 472 | move=> c x. 473 | rewrite (proj2 (proj2 H1) c x). 474 | apply (proj2 (proj2 H2) c (f x)). 475 | Qed. 476 | 477 | Lemma IsomorphicInvVS : forall (F : Field) (v1 v2 : VectorSpace F) (f : VT F v1 -> VT F v2) (g : VT F v2 -> VT F v1), IsomorphicVS F v1 v2 f -> (forall (x : VT F v1), g (f x) = x) /\ (forall (y : VT F v2), f (g y) = y) -> IsomorphicVS F v2 v1 g. 478 | Proof. 479 | move=> F v1 v2 f g H1 H2. 480 | apply conj. 481 | exists f. 482 | apply conj. 483 | apply (proj2 H2). 484 | apply (proj1 H2). 485 | apply conj. 486 | move=> x y. 487 | apply (BijInj (VT F v1) (VT F v2) f (proj1 H1) (g (Vadd F v2 x y)) (Vadd F v1 (g x) (g y))). 488 | rewrite (proj1 (proj2 H1) (g x) (g y)). 489 | rewrite (proj2 H2 x). 490 | rewrite (proj2 H2 y). 491 | apply (proj2 H2 (Vadd F v2 x y)). 492 | move=> c x. 493 | apply (BijInj (VT F v1) (VT F v2) f (proj1 H1) (g (Vmul F v2 c x)) (Vmul F v1 c (g x))). 494 | rewrite (proj2 (proj2 H1) c (g x)). 495 | rewrite (proj2 H2 x). 496 | apply (proj2 H2 (Vmul F v2 c x)). 497 | Qed. 498 | 499 | Definition Fn (F : Field) (N : nat) := ({m : nat | m < N} -> FT F). 500 | 501 | Definition Fnadd (F : Field) (N : nat) := fun (f1 f2 : Fn F N) => (fun (n : {m : nat | m < N}) => Fadd F (f1 n) (f2 n)). 502 | 503 | Definition Fnmul (F : Field) (N : nat) := fun (c : FT F) (f : Fn F N) => (fun (n : {m : nat | m < N}) => Fmul F c (f n)). 504 | 505 | Definition Fnopp (F : Field) (N : nat) := fun (f : (Fn F N)) => (fun (n : {m : nat | m < N}) => Fopp F (f n)). 506 | 507 | Definition Fnminus (F : Field) (N : nat) := fun (f1 f2 : (Fn F N)) => (Fnadd F N f1 (Fnopp F N f2)). 508 | 509 | Definition FnO (F : Field) (N : nat) := (fun (n : {m : nat | m < N}) => FO F). 510 | 511 | Lemma Fnadd_comm : forall (F : Field) (N : nat) (f1 f2 : Fn F N), (Fnadd F N f1 f2) = (Fnadd F N f2 f1). 512 | Proof. 513 | move=> F N f1 f2. 514 | apply functional_extensionality. 515 | move=> n. 516 | apply (Fadd_comm F (f1 n) (f2 n)). 517 | Qed. 518 | 519 | Lemma Fnadd_assoc : forall (F : Field) (N : nat) (f1 f2 f3 : Fn F N), (Fnadd F N (Fnadd F N f1 f2) f3) = (Fnadd F N f1 (Fnadd F N f2 f3)). 520 | Proof. 521 | move=> F N f1 f2 f3. 522 | apply functional_extensionality. 523 | move=> n. 524 | apply (Fadd_assoc F (f1 n) (f2 n) (f3 n)). 525 | Qed. 526 | 527 | Lemma Fnadd_O_l : forall (F : Field) (N : nat) (f : Fn F N), (Fnadd F N (FnO F N) f) = f. 528 | Proof. 529 | move=> F N f. 530 | apply functional_extensionality. 531 | move=> n. 532 | apply (Fadd_O_l F (f n)). 533 | Qed. 534 | 535 | Lemma Fnadd_opp_r : forall (F : Field) (N : nat) (f : Fn F N), (Fnadd F N f (Fnopp F N f)) = (FnO F N). 536 | Proof. 537 | move=> F N f. 538 | apply functional_extensionality. 539 | move=> n. 540 | apply (Fadd_opp_r F (f n)). 541 | Qed. 542 | 543 | Lemma Fnadd_distr_l : forall (F : Field) (N : nat) (c : FT F) (f1 f2 : Fn F N), (Fnmul F N c (Fnadd F N f1 f2)) = (Fnadd F N (Fnmul F N c f1) (Fnmul F N c f2)). 544 | Proof. 545 | move=> F N c f1 f2. 546 | apply functional_extensionality. 547 | move=> n. 548 | apply (Fmul_add_distr_l F c (f1 n) (f2 n)). 549 | Qed. 550 | 551 | Lemma Fnadd_distr_r : forall (F : Field) (N : nat) (c1 c2 : FT F) (f : Fn F N), (Fnmul F N (Fadd F c1 c2) f) = (Fnadd F N (Fnmul F N c1 f) (Fnmul F N c2 f)). 552 | Proof. 553 | move=> F N c1 c2 f. 554 | apply functional_extensionality. 555 | move=> n. 556 | apply (Fmul_add_distr_r F c1 c2 (f n)). 557 | Qed. 558 | 559 | Lemma Fnmul_assoc : forall (F : Field) (N : nat) (c1 c2 : FT F) (f : Fn F N), (Fnmul F N c1 (Fnmul F N c2 f)) = (Fnmul F N (Fmul F c1 c2) f). 560 | Proof. 561 | move=> F N c1 c2 f. 562 | apply functional_extensionality. 563 | move=> n. 564 | unfold Fnmul. 565 | rewrite (Fmul_assoc F c1 c2 (f n)). 566 | reflexivity. 567 | Qed. 568 | 569 | Lemma Fnmul_I_l : forall (F : Field) (N : nat) (f : Fn F N), (Fnmul F N (FI F) f) = f. 570 | Proof. 571 | move=> F N f. 572 | apply functional_extensionality. 573 | move=> n. 574 | apply (Fmul_I_l F (f n)). 575 | Qed. 576 | 577 | Definition FnVS (F : Field) (N : nat) := mkVectorSpace F (Fn F N) (FnO F N) (Fnadd F N) (Fnmul F N) (Fnopp F N) (Fnadd_comm F N) (Fnadd_assoc F N) (Fnadd_O_l F N) (Fnadd_opp_r F N) (Fnadd_distr_l F N) (Fnadd_distr_r F N) (Fnmul_assoc F N) (Fnmul_I_l F N). 578 | 579 | Definition FVS (F : Field) := mkVectorSpace F (FT F) (FO F) (Fadd F) (Fmul F) (Fopp F) (Fadd_comm F) (Fadd_assoc F) (Fadd_O_l F) (Fadd_opp_r F) (Fmul_add_distr_l F) (Fmul_add_distr_r F) (Fmul_assoc_reverse F) (Fmul_I_l F). 580 | 581 | End VectorSpace. 582 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # 使い方 2 | まずmakeでコンパイルします。 3 | ルートディレクトリでcoqideを実行して使えます。 -------------------------------------------------------------------------------- /Tools/BasicTools.v: -------------------------------------------------------------------------------- 1 | From mathcomp Require Import ssreflect. 2 | Require Import Coq.Logic.ProofIrrelevance. 3 | Require Import Coq.Logic.JMeq. 4 | 5 | Lemma sig_map : forall {T : Type} (P : T -> Prop) (x : {x : T | P x}) (y : {x : T | P x}), proj1_sig x = proj1_sig y -> x = y. 6 | Proof. 7 | move=> T P. 8 | suff: (forall (xv yv : T), xv = yv -> forall (xp : P xv) (yp : P yv), exist P xv xp = exist P yv yp). 9 | move=> H1 x y. 10 | elim x. 11 | move=> xv xp. 12 | elim y. 13 | move=> yv yp. 14 | simpl. 15 | move=> H2. 16 | apply (H1 xv yv H2 xp yp). 17 | move=> xv yv H1. 18 | rewrite H1. 19 | move=> xp yp. 20 | rewrite (proof_irrelevance (P yv) yp xp). 21 | reflexivity. 22 | Qed. 23 | 24 | Lemma TypeEqConvertExist : forall (T1 T2 : Type), T1 = T2 -> {f : T1 -> T2 | forall (t : T1), JMeq t (f t)}. 25 | Proof. 26 | move=> T1 T2 H1. 27 | rewrite H1. 28 | exists (fun (t : T2) => t). 29 | move=> t. 30 | apply (JMeq_refl t). 31 | Qed. 32 | 33 | Definition TypeEqConvert (T1 T2 : Type) (H : T1 = T2) := proj1_sig (TypeEqConvertExist T1 T2 H). 34 | 35 | Lemma TypeEqConvertNature : forall (T : Type) (H : T = T) (t : T), TypeEqConvert T T H t = t. 36 | Proof. 37 | move=> T H t. 38 | apply JMeq_eq. 39 | apply JMeq_sym. 40 | apply (proj2_sig (TypeEqConvertExist T T H) t). 41 | Qed. 42 | -------------------------------------------------------------------------------- /Tools/MyProd.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Lists.List. 2 | 3 | Record Monoid : Type := mkMonoid 4 | { 5 | MoT : Type; 6 | Moe : MoT; 7 | Moc : MoT -> MoT -> MoT; 8 | Mo_O_r : forall (x : MoT), (Moc x Moe) = x; 9 | Mo_O_l : forall (x : MoT), (Moc Moe x) = x; 10 | Mo_assoc : forall (x y z : MoT), (Moc (Moc x y) z) = (Moc x (Moc y z)) 11 | }. 12 | 13 | Definition MyProdFL (mo : Monoid) (a : list (MoT mo)) := fold_right (fun (m0 : MoT mo) (m : MoT mo) => Moc mo m0 m) (Moe mo) a. 14 | 15 | Lemma MyProdFLSingle : forall (mo : Monoid) (m : MoT mo), MyProdFL mo (m :: nil) = m. 16 | Proof. 17 | intros mo m. 18 | apply (Mo_O_r mo m). 19 | Qed. 20 | 21 | Lemma MyProdFLApp : forall (mo : Monoid) (a b : list (MoT mo)), MyProdFL mo (app a b) = Moc mo (MyProdFL mo a) (MyProdFL mo b). 22 | Proof. 23 | intros mo a b. 24 | elim a. 25 | simpl. 26 | rewrite (Mo_O_l mo (MyProdFL mo b)). 27 | reflexivity. 28 | intros a0 l H1. 29 | simpl. 30 | rewrite H1. 31 | rewrite (Mo_assoc mo a0 (MyProdFL mo l) (MyProdFL mo b)). 32 | reflexivity. 33 | Qed. 34 | 35 | Lemma Mo_assoc_reverse : forall (mo : Monoid) (m1 m2 m3 : MoT mo), Moc mo m3 (Moc mo m2 m1) = Moc mo (Moc mo m3 m2) m1. 36 | Proof. 37 | intros mo m1 m2 m3. 38 | rewrite (Mo_assoc mo m3 m2 m1). 39 | reflexivity. 40 | Qed. 41 | 42 | Definition ReverseMonoid (mo : Monoid) := mkMonoid (MoT mo) (Moe mo) (fun (m1 m2 : MoT mo) => Moc mo m2 m1) (Mo_O_l mo) (Mo_O_r mo) (Mo_assoc_reverse mo). 43 | 44 | Lemma MyProdFLReverse : forall (mo : Monoid) (a : list (MoT mo)), MyProdFL mo a = MyProdFL (ReverseMonoid mo) (rev a). 45 | Proof. 46 | intros mo a. 47 | elim a. 48 | reflexivity. 49 | intros a0 l H1. 50 | simpl. 51 | rewrite H1. 52 | cut ((@app (MoT mo) (@rev (MoT mo) l) (@cons (MoT mo) a0 (@nil (MoT mo)))) = (@app (MoT (ReverseMonoid mo)) (@rev (MoT mo) l) (@cons (MoT mo) a0 (@nil (MoT mo))))). 53 | intro H2. 54 | rewrite H2. 55 | rewrite (MyProdFLApp (ReverseMonoid mo) (rev l) (a0 :: nil)). 56 | cut ((@cons (MoT mo) a0 (@nil (MoT mo))) = (@cons (MoT (ReverseMonoid mo)) a0 (@nil (MoT (ReverseMonoid mo))))). 57 | intro H3. 58 | rewrite H3. 59 | rewrite (MyProdFLSingle (ReverseMonoid mo) a0). 60 | reflexivity. 61 | reflexivity. 62 | reflexivity. 63 | Qed. 64 | -------------------------------------------------------------------------------- /Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn1AC.v: -------------------------------------------------------------------------------- 1 | Add LoadPath "Tools" as Tools. 2 | Add LoadPath "BasicProperty" as BasicProperty. 3 | Add LoadPath "LibraryExtension" as LibraryExtension. 4 | Add LoadPath "Topology/ShuugouIsouNyuumonn" as Topology.ShuugouIsouNyuumonn. 5 | 6 | From mathcomp Require Import ssreflect. 7 | Require Import Coq.Logic.Classical_Prop. 8 | Require Import Coq.Logic.FunctionalExtensionality. 9 | Require Import Coq.Logic.IndefiniteDescription. 10 | Require Import Coq.Sets.Ensembles. 11 | Require Import Coq.Program.Basics. 12 | Require Import Topology.ShuugouIsouNyuumonn.ShuugouIsouNyuumonn1. 13 | Require Import BasicProperty.MappingProperty. 14 | 15 | Lemma Formula_P47_2 : forall (U : Type) (T : U -> Type) (A : forall (u : U), Ensemble (T u)), (forall (u : U), A u <> Empty_set (T u)) -> ProductionEnsemble U T A <> Empty_set (forall (u : U), T u). 16 | Proof. 17 | move=> U T A H1 H2. 18 | suff: (forall (u : U), {t : T u | In (T u) (A u) t}). 19 | move=> H3. 20 | suff: (In (forall (u : U), T u) (ProductionEnsemble U T A) (fun (u : U) => proj1_sig (H3 u))). 21 | rewrite H2. 22 | elim. 23 | apply (ProductionEnsemble_intro U T A). 24 | apply (fun (u : U) => proj2_sig (H3 u)). 25 | move=> u. 26 | apply constructive_indefinite_description. 27 | apply NNPP. 28 | move=> H3. 29 | apply (H1 u). 30 | apply Extensionality_Ensembles. 31 | apply conj. 32 | move=> u0 H4. 33 | apply False_ind. 34 | apply H3. 35 | exists u0. 36 | apply H4. 37 | move=> u0. 38 | elim. 39 | Qed. 40 | 41 | Lemma Theorem_7_1_1 : forall (U T : Type) (f : U -> T), Surjective f -> exists (g : T -> U), compose f g = (fun (t : T) => t). 42 | Proof. 43 | move=> U T f H1. 44 | suff: (forall (t : T), {u : U | f u = t}). 45 | move=> H2. 46 | exists (fun (t : T) => proj1_sig (H2 t)). 47 | apply functional_extensionality. 48 | move=> t. 49 | apply (proj2_sig (H2 t)). 50 | move=> t. 51 | apply constructive_indefinite_description. 52 | apply (H1 t). 53 | Qed. 54 | 55 | Lemma Theorem_7_corollary_2 : forall (U T : Type), (exists (f : U -> T), Surjective f) -> (exists (g : T -> U), Injective g). 56 | Proof. 57 | move=> U T. 58 | elim. 59 | move=> f H1. 60 | elim (Theorem_7_1_1 U T f H1). 61 | move=> g H2. 62 | exists g. 63 | apply (Theorem_7_2_2 T U g). 64 | exists f. 65 | apply H2. 66 | Qed. 67 | -------------------------------------------------------------------------------- /Topology/ShuugouIsouNyuumonn/ShuugouIsouNyuumonn2AC.v: -------------------------------------------------------------------------------- 1 | Add LoadPath "Analysis/KaisekiNyuumonn" as Analysis.KaisekiNyuumonn. 2 | Add LoadPath "MyAlgebraicStructure" as MyAlgebraicStructure. 3 | Add LoadPath "Tools" as Tools. 4 | Add LoadPath "BasicProperty" as BasicProperty. 5 | Add LoadPath "LibraryExtension" as LibraryExtension. 6 | Add LoadPath "Topology/ShuugouIsouNyuumonn" as Topology.ShuugouIsouNyuumonn. 7 | Add LoadPath "LibraryExtension" as LibraryExtension. 8 | Add LoadPath "Topology/ShuugouIsouNyuumonn" as Topology.ShuugouIsouNyuumonn. 9 | 10 | From mathcomp Require Import ssreflect. 11 | Require Import Coq.Program.Basics. 12 | Require Import Coq.Program.Combinators. 13 | Require Import Coq.Sets.Ensembles. 14 | Require Import Coq.Sets.Finite_sets. 15 | Require Import Coq.Sets.Image. 16 | Require Import Coq.Logic.ClassicalDescription. 17 | Require Import Coq.Logic.IndefiniteDescription. 18 | Require Import Tools.MySum. 19 | Require Import Tools.BasicTools. 20 | Require Import BasicProperty.MappingProperty. 21 | Require Import LibraryExtension.DatatypesExtension. 22 | Require Import Topology.ShuugouIsouNyuumonn.ShuugouIsouNyuumonn1. 23 | Require Import Topology.ShuugouIsouNyuumonn.ShuugouIsouNyuumonn1AC. 24 | Require Import Topology.ShuugouIsouNyuumonn.ShuugouIsouNyuumonn2. 25 | 26 | Lemma Theorem_2_dash : forall (A B : Type), (exists (f : A -> B), Injective f) -> (exists (g : A -> B), Surjective g) -> SameCard A B. 27 | Proof. 28 | move=> A B H1 H2. 29 | apply (Theorem_2 A B H1 (Theorem_7_corollary_2 A B H2)). 30 | Qed. 31 | 32 | Lemma Theorem_2_dash_dash : forall (A B : Type), (exists (f : A -> B), Surjective f) -> (exists (g : B -> A), Surjective g) -> SameCard A B. 33 | Proof. 34 | move=> A B H1 H2. 35 | apply (Theorem_2 A B (Theorem_7_corollary_2 B A H2) (Theorem_7_corollary_2 A B H1)). 36 | Qed. 37 | 38 | Lemma cardLeDef3 : forall (A B : Type), A -> cardLe A B <-> exists (f : B -> A), Surjective f. 39 | Proof. 40 | move=> A B a. 41 | apply conj. 42 | move=> H1. 43 | apply (Theorem_7_corollary_1 A B a H1). 44 | move=> H1. 45 | apply (Theorem_7_corollary_2 B A H1). 46 | Qed. 47 | 48 | Lemma Theorem_4 : forall (T : Type), ~ Finite T (Full_set T) -> exists (A : Ensemble T), SameCard {t : T | In T A t} nat. 49 | Proof. 50 | move=> T H1. 51 | suff: (forall (A : {B : Ensemble T | ~ Finite T B}), {t : T | In T (proj1_sig A) t}). 52 | move=> H2. 53 | suff: (forall (A : Ensemble T) (t : T), In T A t -> ~ Finite T A -> ~ Finite T (Subtract T A t)). 54 | move=> H3. 55 | suff: (let F := fix F (n : nat) : (T * {B : Ensemble T | ~ Finite T B}) := match n with 56 | | O => (proj1_sig (H2 (exist (fun (A : Ensemble T) => ~ Finite T A) (Full_set T) H1)), (exist (fun (A : Ensemble T) => ~ Finite T A) (Subtract T (Full_set T) (proj1_sig (H2 (exist (fun (A : Ensemble T) => ~ Finite T A) (Full_set T) H1)))) (H3 (Full_set T) (proj1_sig (H2 (exist (fun (A : Ensemble T) => ~ Finite T A) (Full_set T) H1))) (proj2_sig (H2 (exist (fun (A : Ensemble T) => ~ Finite T A) (Full_set T) H1))) H1))) 57 | | S n => (proj1_sig (H2 (snd (F n))), (exist (fun (A : Ensemble T) => ~ Finite T A) (Subtract T (proj1_sig (snd (F n))) (proj1_sig (H2 (snd (F n))))) (H3 (proj1_sig (snd (F n))) (proj1_sig (H2 (snd (F n)))) (proj2_sig (H2 (snd (F n)))) (proj2_sig (snd (F n)))))) 58 | end in exists (A : Ensemble T), SameCard {t : T | In T A t} nat). 59 | apply. 60 | move=> F. 61 | exists (Im nat T (Full_set nat) (fun (n : nat) => fst (F n))). 62 | apply Formula_1_2. 63 | exists (fun (m : nat) => exist (Im nat T (Full_set nat) (fun (n : nat) => fst (F n))) (fst (F m)) (Im_intro nat T (Full_set nat) (fun (n : nat) => fst (F n)) m (Full_intro nat m) (fst (F m)) eq_refl)). 64 | apply InjSurjBij. 65 | suff: (forall (m1 m2 : nat), m1 <= m2 -> Included T (proj1_sig (snd (F m2))) (proj1_sig (snd (F m1)))). 66 | move=> H4. 67 | suff: (forall (m1 m2 : nat), m1 < m2 -> fst (F m1) <> fst (F m2)). 68 | move=> H5 m1 m2 H6. 69 | elim (le_or_lt m1 m2). 70 | move=> H7. 71 | elim (le_lt_or_eq m1 m2 H7). 72 | move=> H8. 73 | elim (H5 m1 m2 H8). 74 | suff: (fst (F m1) = proj1_sig (exist (Im nat T (Full_set nat) (fun (n : nat) => fst (F n))) (fst (F m1)) (Im_intro nat T (Full_set nat) (fun (n : nat) => fst (F n)) m1 (Full_intro nat m1) (fst (F m1)) eq_refl))). 75 | move=> H9. 76 | rewrite H9. 77 | rewrite H6. 78 | reflexivity. 79 | reflexivity. 80 | apply. 81 | move=> H7. 82 | elim (H5 m2 m1 H7). 83 | suff: (fst (F m1) = proj1_sig (exist (Im nat T (Full_set nat) (fun (n : nat) => fst (F n))) (fst (F m1)) (Im_intro nat T (Full_set nat) (fun (n : nat) => fst (F n)) m1 (Full_intro nat m1) (fst (F m1)) eq_refl))). 84 | move=> H8. 85 | rewrite H8. 86 | rewrite H6. 87 | reflexivity. 88 | reflexivity. 89 | move=> m1 m2 H5 H6. 90 | suff: (~ In T (proj1_sig (snd (F m1))) (fst (F m1))). 91 | elim. 92 | suff: (exists (n : nat), m2 = S n). 93 | elim. 94 | move=> n H7. 95 | apply (H4 m1 n). 96 | apply (le_S_n m1 n). 97 | rewrite - H7. 98 | apply H5. 99 | rewrite H6. 100 | rewrite H7. 101 | apply (proj2_sig (H2 (snd (F n)))). 102 | suff: (m1 < m2). 103 | elim m2. 104 | move=> H7. 105 | elim (le_not_lt O m1 (le_0_n m1) H7). 106 | move=> k H7 H8. 107 | exists k. 108 | reflexivity. 109 | apply H5. 110 | elim m1. 111 | move=> H7. 112 | apply (proj2 H7). 113 | apply (In_singleton T). 114 | move=> n H7 H8. 115 | apply (proj2 H8). 116 | apply (In_singleton T). 117 | move=> m1 m2. 118 | elim. 119 | move=> t H4. 120 | apply H4. 121 | move=> m3 H4 H5 t H6. 122 | apply (H5 t). 123 | apply (proj1 H6). 124 | move=> t. 125 | suff: (exists (n : nat), fst (F n) = proj1_sig t). 126 | elim. 127 | move=> n H4. 128 | exists n. 129 | apply sig_map. 130 | apply H4. 131 | elim (proj2_sig t). 132 | move=> x H4 y H5. 133 | exists x. 134 | rewrite H5. 135 | reflexivity. 136 | move=> A t H3 H4 H5. 137 | apply H4. 138 | suff: (A = Add T (Subtract T A t) t). 139 | move=> H6. 140 | rewrite H6. 141 | apply (Union_is_finite T (Subtract T A t) H5 t). 142 | move=> H7. 143 | apply (proj2 H7). 144 | apply (In_singleton T t). 145 | apply Extensionality_Ensembles. 146 | apply conj. 147 | move=> a H6. 148 | elim (classic (t = a)). 149 | move=> H7. 150 | right. 151 | rewrite H7. 152 | apply (In_singleton T a). 153 | move=> H7. 154 | left. 155 | apply conj. 156 | apply H6. 157 | move=> H8. 158 | apply H7. 159 | elim H8. 160 | reflexivity. 161 | move=> a. 162 | elim. 163 | move=> t0 H6. 164 | apply (proj1 H6). 165 | move=> t0. 166 | elim. 167 | apply H3. 168 | move=> A. 169 | apply constructive_indefinite_description. 170 | apply NNPP. 171 | move=> H2. 172 | apply (proj2_sig A). 173 | suff: (proj1_sig A = Empty_set T). 174 | move=> H3. 175 | rewrite H3. 176 | apply (Empty_is_finite T). 177 | apply Extensionality_Ensembles. 178 | apply conj. 179 | move=> t H3. 180 | elim H2. 181 | exists t. 182 | apply H3. 183 | move=> t. 184 | elim. 185 | Qed. 186 | 187 | Lemma Theorem_4_corollary : forall (C : CardT), InfiniteCard C -> CardLe (Card nat) C. 188 | Proof. 189 | move=> C H1. 190 | elim (proj2_sig C). 191 | move=> T H2. 192 | rewrite - (CardLeNature nat T (Card nat) C (ERref Type CardEquivalence nat)). 193 | apply (proj2 (cardLeDef2 nat T)). 194 | elim (Theorem_4 T). 195 | move=> B H3. 196 | exists B. 197 | apply (Formula_1_2 {t : T | In T B t} nat H3). 198 | move=> H3. 199 | apply H1. 200 | elim (finite_cardinal T (Full_set T) H3). 201 | move=> n H4. 202 | exists n. 203 | suff: (C = EquivalenceRelationQuotientFunction Type CardEquivalence T). 204 | move=> H5. 205 | rewrite H5. 206 | apply (Formula_66_1 T (Count n)). 207 | apply (Formula_1_2 (Count n) T (proj2 (CountCardinalBijective T n) H4)). 208 | apply sig_map. 209 | apply H2. 210 | rewrite H2. 211 | apply (Formula_1_1 T). 212 | Qed. 213 | 214 | Lemma Theorem_5_2_1 : forall (T : Type) (Ti : T -> Type), cardLe T nat -> (forall (t : T), cardLe (Ti t) nat) -> cardLe (sumT T Ti) nat. 215 | Proof. 216 | move=> T Ti. 217 | elim. 218 | move=> f H1 H2. 219 | suff: (forall (t : T), {fi : Ti t -> nat | Injective fi}). 220 | move=> H3. 221 | elim (Formula_1_2 nat (nat * nat) Example_3). 222 | move=> g H4. 223 | exists (fun (x : sumT T Ti) => match x with 224 | | inT t tf => g (f t, proj1_sig (H3 t) tf) 225 | end). 226 | suff: (forall (t1 t2 : T), (t1 = t2) -> forall (tf1 : Ti t1) (tf2 : Ti t2), proj1_sig (H3 t1) tf1 = proj1_sig (H3 t2) tf2 -> inT T Ti t1 tf1 = inT T Ti t2 tf2). 227 | move=> H5 x1 x2. 228 | elim x1. 229 | move=> t1 tf1. 230 | elim x2. 231 | move=> t2 tf2 H6. 232 | apply (H5 t1 t2). 233 | apply (H1 t1 t2). 234 | suff: (f t1 = fst (f t1, proj1_sig (H3 t1) tf1)). 235 | move=> H7. 236 | rewrite H7. 237 | rewrite (BijInj (nat * nat) nat g H4 (f t1, proj1_sig (H3 t1) tf1) (f t2, proj1_sig (H3 t2) tf2) H6). 238 | reflexivity. 239 | reflexivity. 240 | suff: (proj1_sig (H3 t1) tf1 = snd (f t1, proj1_sig (H3 t1) tf1)). 241 | move=> H7. 242 | rewrite H7. 243 | rewrite (BijInj (nat * nat) nat g H4 (f t1, proj1_sig (H3 t1) tf1) (f t2, proj1_sig (H3 t2) tf2) H6). 244 | reflexivity. 245 | reflexivity. 246 | move=> t1 t2 H5. 247 | rewrite H5. 248 | move=> tf1 tf2 H6. 249 | rewrite (proj2_sig (H3 t2) tf1 tf2 H6). 250 | reflexivity. 251 | move=> t. 252 | apply constructive_indefinite_description. 253 | apply (H2 t). 254 | Qed. 255 | 256 | Lemma Theorem_5_2_2 : forall (T : Type) (Ti : T -> Type), cardLe T nat -> (forall (t : T), cardLe (Ti t) nat) -> (exists (t : T), SameCard (Ti t) nat) -> SameCard (sumT T Ti) nat. 257 | Proof. 258 | move=> T Ti H1 H2 H3. 259 | apply (Theorem_2 (sumT T Ti) nat). 260 | apply (Theorem_5_2_1 T Ti H1 H2). 261 | elim H3. 262 | move=> t H4. 263 | elim (Formula_1_2 (Ti t) nat H4). 264 | move=> f H5. 265 | exists (fun (n : nat) => inT T Ti t (f n)). 266 | move=> n1 n2 H6. 267 | apply (BijInj nat (Ti t) f H5 n1 n2). 268 | suff: (f n1 = let temp := inT T Ti t (f n1) in match temp with 269 | | inT t0 tf0 => match excluded_middle_informative (t0 = t) with 270 | | left H => TypeEqConvert (Ti t0) (Ti t) (f_equal Ti H) tf0 271 | | right _ => f n1 272 | end 273 | end). 274 | move=> H7. 275 | rewrite H7. 276 | rewrite H6. 277 | simpl. 278 | elim (excluded_middle_informative (t = t)). 279 | move=> H8. 280 | apply (TypeEqConvertNature (Ti t) (f_equal Ti H8) (f n2)). 281 | elim. 282 | reflexivity. 283 | simpl. 284 | elim (excluded_middle_informative (t = t)). 285 | move=> H7. 286 | rewrite (TypeEqConvertNature (Ti t) (f_equal Ti H7) (f n1)). 287 | reflexivity. 288 | elim. 289 | reflexivity. 290 | Qed. 291 | 292 | Lemma Theorem_6 : forall (T : Type) (A : Ensemble T), ~ Finite T (Complement T A) -> cardLe {t : T | In T A t} nat -> SameCard T {t : T | ~ In T A t}. 293 | Proof. 294 | move=> T A H1 H2. 295 | suff: (exists (B : Ensemble T), SameCard {t : T | ~ In T A t /\ In T B t} nat). 296 | elim. 297 | move=> B H3. 298 | suff: (SameCard {t : T | In T A t \/ In T B t} {t : T | ~ In T A t /\ In T B t}). 299 | elim. 300 | move=> f. 301 | elim. 302 | move=> g H4. 303 | suff: (forall (t : T), ~ (In T A t \/ In T B t) -> ~ In T A t). 304 | move=> H5. 305 | exists (fun (t : T) => match excluded_middle_informative (In T A t \/ In T B t) with 306 | | left H => exist (fun (t : T) => ~ In T A t) (proj1_sig (f (exist (fun (t : T) => In T A t \/ In T B t) t H))) (proj1 (proj2_sig (f (exist (fun (t : T) => In T A t \/ In T B t) t H)))) 307 | | right H => exist (fun (t : T) => ~ In T A t) t (H5 t H) 308 | end). 309 | exists (fun (t : {t : T | ~ In T A t}) => match excluded_middle_informative (In T B (proj1_sig t)) with 310 | | left H => proj1_sig (g (exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig t) (conj (proj2_sig t) H))) 311 | | right _ => proj1_sig t 312 | end). 313 | apply conj. 314 | move=> x. 315 | elim (excluded_middle_informative (In T A x \/ In T B x)). 316 | move=> H6. 317 | simpl. 318 | elim (excluded_middle_informative (In T B (proj1_sig (f (exist (fun (t : T) => In T A t \/ In T B t) x H6))))). 319 | move=> H7. 320 | suff: ((exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig (f (exist (fun (t : T) => In T A t \/ In T B t) x H6))) (conj (proj1 (proj2_sig (f (exist (fun (t : T) => In T A t \/ In T B t) x H6)))) H7)) = (f (exist (fun (t : T) => In T A t \/ In T B t) x H6))). 321 | move=> H8. 322 | rewrite H8. 323 | rewrite (proj1 H4). 324 | reflexivity. 325 | apply sig_map. 326 | reflexivity. 327 | elim. 328 | apply (proj2 (proj2_sig (f (exist (fun (t : T) => In T A t \/ In T B t) x H6)))). 329 | move=> H6. 330 | elim (excluded_middle_informative (In T B (proj1_sig (exist (fun (t : T) => ~ In T A t) x (H5 x H6))))). 331 | move=> H7. 332 | elim H6. 333 | right. 334 | apply H7. 335 | move=> H7. 336 | reflexivity. 337 | move=> y. 338 | elim (excluded_middle_informative (In T B (proj1_sig y))). 339 | move=> H6. 340 | elim (excluded_middle_informative (In T A (proj1_sig (g (exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig y) (conj (proj2_sig y) H6)))) \/ In T B (proj1_sig (g (exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig y) (conj (proj2_sig y) H6)))))). 341 | move=> H7. 342 | suff: ((exist (fun (t : T) => In T A t \/ In T B t) (proj1_sig (g (exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig y) (conj (proj2_sig y) H6)))) H7) = (g (exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig y) (conj (proj2_sig y) H6)))). 343 | move=> H8. 344 | rewrite H8. 345 | rewrite (proj2 H4). 346 | apply sig_map. 347 | reflexivity. 348 | apply sig_map. 349 | reflexivity. 350 | elim. 351 | apply (proj2_sig (g (exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig y) (conj (proj2_sig y) H6)))). 352 | move=> H6. 353 | elim (excluded_middle_informative (In T A (proj1_sig y) \/ In T B (proj1_sig y))). 354 | move=> H7. 355 | elim H6. 356 | elim H7. 357 | move=> H8. 358 | elim ((proj2_sig y) H8). 359 | apply. 360 | move=> H7. 361 | apply sig_map. 362 | reflexivity. 363 | move=> t H5 H6. 364 | apply H5. 365 | left. 366 | apply H6. 367 | apply (Formula_1_3 {t : T | In T A t \/ In T B t} nat {t : T | ~ In T A t /\ In T B t}). 368 | apply (Theorem_2 {t : T | In T A t \/ In T B t} nat). 369 | elim (Formula_1_2 nat (nat * nat) Example_3). 370 | move=> f H4. 371 | elim H2. 372 | move=> g H5. 373 | elim H3. 374 | move=> h H6. 375 | suff: (forall (t : {t : T | In T A t \/ In T B t}), ~ In T A (proj1_sig t) -> ~ In T A (proj1_sig t) /\ In T B (proj1_sig t)). 376 | move=> H7. 377 | exists (fun (t : {t : T | In T A t \/ In T B t}) => match excluded_middle_informative (In T A (proj1_sig t)) with 378 | | left H => f (g (exist A (proj1_sig t) H), O) 379 | | right H => f (h (exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig t) (H7 t H)), 1) 380 | end). 381 | move=> t1 t2. 382 | elim (excluded_middle_informative (In T A (proj1_sig t1))). 383 | move=> H8. 384 | elim (excluded_middle_informative (In T A (proj1_sig t2))). 385 | move=> H9 H10. 386 | apply sig_map. 387 | suff: (proj1_sig t1 = proj1_sig (exist A (proj1_sig t1) H8)). 388 | move=> H11. 389 | rewrite H11. 390 | rewrite (H5 (exist A (proj1_sig t1) H8) (exist A (proj1_sig t2) H9)). 391 | reflexivity. 392 | suff: (g (exist A (proj1_sig t1) H8) = fst (g (exist A (proj1_sig t1) H8), 0)). 393 | move=> H12. 394 | rewrite H12. 395 | rewrite (BijInj (nat * nat) nat f H4 (g (exist A (proj1_sig t1) H8), 0) (g (exist A (proj1_sig t2) H9), 0) H10). 396 | reflexivity. 397 | reflexivity. 398 | reflexivity. 399 | move=> H9 H10. 400 | elim (lt_irrefl (snd (g (exist A (proj1_sig t1) H8), 0))). 401 | rewrite {2} (BijInj (nat * nat) nat f H4 (g (exist A (proj1_sig t1) H8), 0) (h (exist (fun t : T => ~ In T A t /\ In T B t) (proj1_sig t2) (H7 t2 H9)), 1) H10). 402 | apply (le_n 1). 403 | move=> H8. 404 | elim (excluded_middle_informative (In T A (proj1_sig t2))). 405 | move=> H9 H10. 406 | elim (lt_irrefl (snd (h (exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig t1) (H7 t1 H8)), 1))). 407 | rewrite {1} (BijInj (nat * nat) nat f H4 (h (exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig t1) (H7 t1 H8)), 1) (g (exist A (proj1_sig t2) H9), 0) H10). 408 | apply (le_n 1). 409 | move=> H9 H10. 410 | apply sig_map. 411 | suff: (proj1_sig t1 = proj1_sig (exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig t1) (H7 t1 H8))). 412 | move=> H11. 413 | rewrite H11. 414 | rewrite (BijInj {t : T | ~ In T A t /\ In T B t} nat h H6 (exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig t1) (H7 t1 H8)) (exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig t2) (H7 t2 H9))). 415 | reflexivity. 416 | suff: (h (exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig t1) (H7 t1 H8)) = fst (h (exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig t1) (H7 t1 H8)), 1)). 417 | move=> H12. 418 | rewrite H12. 419 | rewrite (BijInj (nat * nat) nat f H4 (h (exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig t1) (H7 t1 H8)), 1) (h (exist (fun (t : T) => ~ In T A t /\ In T B t) (proj1_sig t2) (H7 t2 H9)), 1) H10). 420 | reflexivity. 421 | reflexivity. 422 | reflexivity. 423 | move=> t H7. 424 | apply conj. 425 | apply H7. 426 | elim (proj2_sig t). 427 | move=> H8. 428 | elim (H7 H8). 429 | apply. 430 | elim (Formula_1_2 {t : T | ~ In T A t /\ In T B t} nat H3). 431 | move=> f H4. 432 | suff: (forall (n : nat), In T A (proj1_sig (f n)) \/ In T B (proj1_sig (f n))). 433 | move=> H5. 434 | exists (fun (n : nat) => exist (fun (t : T) => In T A t \/ In T B t) (proj1_sig (f n)) (H5 n)). 435 | move=> n1 n2 H6. 436 | apply (BijInj nat {t : T | ~ In T A t /\ In T B t} f H4 n1 n2). 437 | apply sig_map. 438 | suff: (proj1_sig (f n1) = proj1_sig (exist (fun (t : T) => In T A t \/ In T B t) (proj1_sig (f n1)) (H5 n1))). 439 | move=> H7. 440 | rewrite H7. 441 | rewrite H6. 442 | reflexivity. 443 | reflexivity. 444 | move=> n. 445 | right. 446 | apply (proj2 (proj2_sig (f n))). 447 | apply (Formula_1_2 {t : T | ~ In T A t /\ In T B t} nat H3). 448 | elim (Theorem_4 {t : T | In T (Complement T A) t}). 449 | move=> B. 450 | elim. 451 | move=> f H3. 452 | exists (fun (t : T) => match excluded_middle_informative (In T A t) with 453 | | left _ => False 454 | | right H => In {t : T | In T (Complement T A) t} B (exist (Complement T A) t H) 455 | end). 456 | suff: (forall (t : {t : T | ~ In T A t /\ In T (fun (t0 : T) => match excluded_middle_informative (In T A t0) with 457 | | left _ => False 458 | | right H => In {t1 : T | In T (Complement T A) t1} B (exist (Complement T A) t0 H) 459 | end) t}), In T (Complement T A) (proj1_sig t)). 460 | move=> H4. 461 | suff: (forall (t : {t : T | ~ In T A t /\ In T (fun (t0 : T) => match excluded_middle_informative (In T A t0) with 462 | | left _ => False 463 | | right H => In {t1 : T | In T (Complement T A) t1} B (exist (Complement T A) t0 H) 464 | end) t}), In {t0 : T | In T (Complement T A) t0} B (exist (Complement T A) (proj1_sig t) (H4 t))). 465 | move=> H5. 466 | exists (fun (t : {t : T | ~ In T A t /\ In T (fun (t0 : T) => match excluded_middle_informative (In T A t0) with 467 | | left _ => False 468 | | right H => In {t1 : T | In T (Complement T A) t1} B (exist (Complement T A) t0 H) 469 | end) t}) => f (exist B (exist (Complement T A) (proj1_sig t) (H4 t)) (H5 t))). 470 | elim H3. 471 | move=> g H6. 472 | suff: (forall (n : nat), In T (fun (t : T) => ~ In T A t /\ In T (fun (t0 : T) => match excluded_middle_informative (In T A t0) with 473 | | left _ => False 474 | | right H => In {t1 : T | In T (Complement T A) t1} B (exist (Complement T A) t0 H) 475 | end) t) (proj1_sig (proj1_sig (g n)))). 476 | move=> H7. 477 | exists (fun (n : nat) => exist (fun (t : T) => ~ In T A t /\ In T (fun (t0 : T) => match excluded_middle_informative (In T A t0) with 478 | | left _ => False 479 | | right H => In {t1 : T | In T (Complement T A) t1} B (exist (Complement T A) t0 H) 480 | end) t) (proj1_sig (proj1_sig (g n))) (H7 n)). 481 | apply conj. 482 | move=> x. 483 | apply sig_map. 484 | simpl. 485 | rewrite (proj1 H6). 486 | reflexivity. 487 | move=> y. 488 | simpl. 489 | rewrite - {6} (proj2 H6 y). 490 | apply (f_equal f). 491 | apply sig_map. 492 | apply sig_map. 493 | reflexivity. 494 | move=> n. 495 | unfold In. 496 | apply conj. 497 | apply (proj2_sig (proj1_sig (g n))). 498 | elim (excluded_middle_informative (A (@proj1_sig T (fun (t : T) => Complement T A t) (@proj1_sig (@sig T (fun (t : T) => Complement T A t)) (fun (t : @sig T (fun (t : T) => Complement T A t)) => B t) (g n))))). 499 | move=> H7. 500 | elim (proj2_sig (proj1_sig (g n)) H7). 501 | move=> H7. 502 | suff: ((exist (Complement T A) (proj1_sig (proj1_sig (g n))) H7) = proj1_sig (g n)). 503 | move=> H8. 504 | rewrite H8. 505 | apply (proj2_sig (g n)). 506 | apply sig_map. 507 | reflexivity. 508 | move=> t. 509 | suff: (In T (fun (t0 : T) => match excluded_middle_informative (In T A t0) with 510 | | left _ => False 511 | | right H => In {t1 : T | In T (Complement T A) t1} B (exist (Complement T A) t0 H) 512 | end) (proj1_sig t)). 513 | unfold In. 514 | elim (excluded_middle_informative (A (@proj1_sig T (fun (t0 : T) => and (not (A t0)) match excluded_middle_informative (A t0) return Prop with 515 | | left _ => False 516 | | right H => B (@exist T (Complement T A) t0 H) 517 | end) t))). 518 | move=> H5. 519 | elim. 520 | move=> H5. 521 | suff: (H5 = H4 t). 522 | move=> H6. 523 | rewrite H6. 524 | apply. 525 | apply proof_irrelevance. 526 | apply (proj2 (proj2_sig t)). 527 | move=> t. 528 | apply (proj1 (proj2_sig t)). 529 | move=> H3. 530 | apply H1. 531 | apply (proj2 (FiniteSigSame T (Complement T A)) H3). 532 | Qed. 533 | 534 | Lemma Theorem_6_corollary_1 : forall (T1 T2 : Type), ~ Finite T1 (Full_set T1) -> cardLe T2 nat -> SameCard T1 (T1 + T2). 535 | Proof. 536 | move=> T1 T2 H1 H2. 537 | elim (Theorem_6 (T1 + T2) (fun (t : T1 + T2) => match t with 538 | | inl _ => False 539 | | inr _ => True 540 | end)). 541 | move=> f. 542 | elim. 543 | move=> g H3. 544 | exists (fun (t : T1) => g (exist (fun (t0 : T1 + T2) => ~ match t0 with 545 | | inl _ => False 546 | | inr _ => True 547 | end) (inl t) (fun (b : False) => b))). 548 | exists (let temp : forall (t : T1 + T2), ~ In (T1 + T2) (fun (t0 : T1 + T2) => match t0 with 549 | | inl _ => False 550 | | inr _ => True 551 | end) t -> T1 := (fun (t : T1 + T2) => match t with 552 | | inl t0 => fun (H : False -> False) => t0 553 | | inr t0 => fun (H : True -> False) => match H I with 554 | end 555 | end) in fun (t : T1 + T2) => temp (proj1_sig (f t)) (proj2_sig (f t))). 556 | apply conj. 557 | move=> t. 558 | simpl. 559 | rewrite (proj2 H3). 560 | reflexivity. 561 | move=> t. 562 | rewrite - {2} (proj1 H3 t). 563 | apply (f_equal g). 564 | apply sig_map. 565 | simpl. 566 | suff: (forall (t1 : T1 + T2) (H : ~ In (T1 + T2) (fun (t1 : T1 + T2) => match t1 with 567 | | inl _ => False 568 | | inr _ => True 569 | end) t1), inl (match t1 as t0 return (~ In (T1 + T2) (fun (t1 : T1 + T2) => match t1 with 570 | | inl _ => False 571 | | inr _ => True 572 | end) t0 -> T1) with 573 | | inl t0 => fun (_ : False -> False) => t0 574 | | inr _ => fun (H : True -> False) => match H I return T1 with 575 | end 576 | end H) = t1). 577 | move=> H4. 578 | apply (H4 (proj1_sig (f t)) (proj2_sig (f t))). 579 | elim. 580 | move=> t1 H4. 581 | reflexivity. 582 | move=> t2 H4. 583 | elim (H4 I). 584 | move=> H3. 585 | apply H1. 586 | apply (proj1 (CountFiniteBijective T1)). 587 | elim (proj2 (CountFiniteBijective {t : T1 + T2 | In (T1 + T2) (Complement (T1 + T2) (fun (t : T1 + T2) => match t with 588 | | inl _ => False 589 | | inr _ => True 590 | end)) t})). 591 | move=> N. 592 | elim. 593 | move=> f. 594 | elim. 595 | move=> g H4. 596 | exists N. 597 | exists (let temp : forall (t : T1 + T2), ~ In (T1 + T2) (fun (t0 : T1 + T2) => match t0 with 598 | | inl _ => False 599 | | inr _ => True 600 | end) t -> T1 := (fun (t : T1 + T2) => match t with 601 | | inl t0 => fun (H : False -> False) => t0 602 | | inr t0 => fun (H : True -> False) => match H I with 603 | end 604 | end) in fun (m : Count N) => temp (proj1_sig (f m)) (proj2_sig (f m))). 605 | exists (fun (t : T1) => g (exist (fun (t0 : T1 + T2) => ~ match t0 with 606 | | inl _ => False 607 | | inr _ => True 608 | end) (inl t) (fun (b : False) => b))). 609 | apply conj. 610 | move=> x. 611 | rewrite - {2} (proj1 H4 x). 612 | apply (f_equal g). 613 | apply sig_map. 614 | simpl. 615 | suff: (forall (t1 : T1 + T2) (H : ~ In (T1 + T2) (fun (t1 : T1 + T2) => match t1 with 616 | | inl _ => False 617 | | inr _ => True 618 | end) t1), inl (match t1 as t0 return (~ In (T1 + T2) (fun (t1 : T1 + T2) => match t1 with 619 | | inl _ => False 620 | | inr _ => True 621 | end) t0 -> T1) with 622 | | inl t0 => fun (_ : False -> False) => t0 623 | | inr _ => fun (H : True -> False) => match H I return T1 with 624 | end 625 | end H) = t1). 626 | move=> H5. 627 | apply (H5 (proj1_sig (f x)) (proj2_sig (f x))). 628 | elim. 629 | move=> t1 H5. 630 | reflexivity. 631 | move=> t2 H5. 632 | elim (H5 I). 633 | move=> y. 634 | simpl. 635 | rewrite (proj2 H4). 636 | reflexivity. 637 | apply (proj1 (FiniteSigSame (T1 + T2) (Complement (T1 + T2) (fun (t : T1 + T2) => match t with 638 | | inl _ => False 639 | | inr _ => True 640 | end))) H3). 641 | elim H2. 642 | move=> f H3. 643 | exists (let temp : forall (t : T1 + T2), (match t with 644 | | inl _ => False 645 | | inr _ => True 646 | end) -> T2 := (fun (t : T1 + T2) => match t with 647 | | inl _ => fun (H : False) => match H with 648 | end 649 | | inr t0 => fun (H : True) => t0 650 | end) in fun (t : {t : T1 + T2 | In (T1 + T2) (fun (t0 : T1 + T2) => match t0 with 651 | | inl _ => False 652 | | inr _ => True 653 | end) t}) => f (temp (proj1_sig t) (proj2_sig t))). 654 | move=> t1 t2. 655 | simpl. 656 | suff: (forall (t1 t2 : T1 + T2) (H1 : In (T1 + T2) (fun (t0 : T1 + T2) => match t0 with 657 | | inl _ => False 658 | | inr _ => True 659 | end) t1) (H2 : In (T1 + T2) (fun (t0 : T1 + T2) => match t0 with 660 | | inl _ => False 661 | | inr _ => True 662 | end) t2), match t1 as t return (match t with 663 | | inl _ => False 664 | | inr _ => True 665 | end -> T2) with 666 | | inl _ => fun (H : False) => match H return T2 with 667 | end 668 | | inr t0 => fun (_ : True) => t0 669 | end H1 = match t2 as t return (match t with 670 | | inl _ => False 671 | | inr _ => True 672 | end -> T2) with 673 | | inl _ => fun (H : False) => match H return T2 with 674 | end 675 | | inr t0 => fun (_ : True) => t0 676 | end H2 -> t1 = t2). 677 | move=> H4 H5. 678 | apply sig_map. 679 | apply (H4 (proj1_sig t1) (proj1_sig t2) (proj2_sig t1) (proj2_sig t2)). 680 | apply H3. 681 | apply H5. 682 | elim. 683 | move=> t3 t4. 684 | elim. 685 | move=> t3. 686 | elim. 687 | move=> t4 H4. 688 | elim. 689 | move=> t4 H5 H6 H7. 690 | rewrite H7. 691 | reflexivity. 692 | Qed. 693 | 694 | Lemma Theorem_6_corollary_2 : forall (T : Type), ~ Finite T (Full_set T) -> exists (A : Ensemble T), Strict_Included T A (Full_set T) /\ SameCard T {t : T | In T A t}. 695 | Proof. 696 | move=> T H1. 697 | suff: (exists (t : T), True). 698 | elim. 699 | move=> t H2. 700 | exists (Complement T (Singleton T t)). 701 | apply conj. 702 | apply conj. 703 | move=> t0 H3. 704 | apply (Full_intro T t0). 705 | move=> H3. 706 | suff: (In T (Complement T (Singleton T t)) t). 707 | move=> H4. 708 | apply H4. 709 | apply (In_singleton T t). 710 | rewrite H3. 711 | apply (Full_intro T t). 712 | apply (Theorem_6 T (Singleton T t)). 713 | move=> H3. 714 | apply H1. 715 | suff: (Full_set T = Add T (Complement T (Singleton T t)) t). 716 | move=> H4. 717 | rewrite H4. 718 | apply (Union_is_finite T (Complement T (Singleton T t)) H3 t). 719 | move=> H5. 720 | apply H5. 721 | apply (In_singleton T t). 722 | apply Extensionality_Ensembles. 723 | apply conj. 724 | move=> t0 H4. 725 | elim (classic (t = t0)). 726 | move=> H5. 727 | rewrite H5. 728 | right. 729 | apply (In_singleton T t0). 730 | move=> H5. 731 | left. 732 | move=> H6. 733 | apply H5. 734 | elim H6. 735 | reflexivity. 736 | move=> t0 H4. 737 | apply (Full_intro T t0). 738 | exists (fun (t1 : {t0 : T | In T (Singleton T t) t0}) => O). 739 | move=> t1 t2 H3. 740 | apply sig_map. 741 | elim (proj2_sig t1). 742 | elim (proj2_sig t2). 743 | reflexivity. 744 | apply NNPP. 745 | move=> H2. 746 | apply H1. 747 | suff: (Full_set T = Empty_set T). 748 | move=> H3. 749 | rewrite H3. 750 | apply (Empty_is_finite T). 751 | apply Extensionality_Ensembles. 752 | apply conj. 753 | move=> t. 754 | elim H2. 755 | exists t. 756 | apply I. 757 | move=> t H3. 758 | apply (Full_intro T t). 759 | Qed. 760 | 761 | Lemma Theorem_9 : forall (T : Type) (tf : T -> Type) (C : CardT), (forall (t : T), Card (tf t) = C) -> Card (sumT T tf) = CardMult C (Card T). 762 | Proof. 763 | move=> T1 tf C H1. 764 | elim (EquivalenceRelationQuotientInhabited Type CardEquivalence C). 765 | move=> T2 H2. 766 | suff: (proj1_sig C T2). 767 | move=> H3. 768 | suff: (forall (t : T1), {ft : tf t -> T2 | Bijective ft}). 769 | move=> H4. 770 | suff: (forall (t : T1), {gt : T2 -> tf t | (forall (x : tf t), gt (proj1_sig (H4 t) x) = x) /\ (forall (y : T2), proj1_sig (H4 t) (gt y) = y)}). 771 | move=> H5. 772 | rewrite - (CardMultNature T2 T1 C (Card T1)). 773 | apply (proj1 (Formula_66_1 (sumT T1 tf) (T2 * T1))). 774 | exists (fun (x : sumT T1 tf) => match x with 775 | | inT t x0 => (proj1_sig (H4 t) x0, t) 776 | end). 777 | exists (fun (x : T2 * T1) => inT T1 tf (snd x) (proj1_sig (H5 (snd x)) (fst x))). 778 | apply conj. 779 | elim. 780 | move=> t x. 781 | rewrite (proj1 (proj2_sig (H5 t)) x). 782 | reflexivity. 783 | elim. 784 | move=> a b. 785 | rewrite (proj2 (proj2_sig (H5 b)) a). 786 | reflexivity. 787 | apply H3. 788 | apply (Formula_1_1 T1). 789 | move=> t. 790 | apply constructive_indefinite_description. 791 | apply (proj2_sig (H4 t)). 792 | move=> t. 793 | apply constructive_indefinite_description. 794 | apply (proj2 (Formula_66_1 (tf t) T2)). 795 | rewrite (H1 t). 796 | apply H2. 797 | rewrite H2. 798 | apply (Formula_1_1 T2). 799 | Qed. 800 | 801 | Lemma Formula_83 : forall (T : Type) (tf : T -> Type) (C : CardT), (forall (t : T), Card (tf t) = C) -> Card (forall (t : T), tf t) = CardPow C (Card T). 802 | Proof. 803 | move=> T1 tf C H1. 804 | elim (EquivalenceRelationQuotientInhabited Type CardEquivalence C). 805 | move=> T2 H2. 806 | suff: (proj1_sig C T2). 807 | move=> H3. 808 | suff: (forall (t : T1), {ft : tf t -> T2 | Bijective ft}). 809 | move=> H4. 810 | suff: (forall (t : T1), {gt : T2 -> tf t | (forall (x : tf t), gt (proj1_sig (H4 t) x) = x) /\ (forall (y : T2), proj1_sig (H4 t) (gt y) = y)}). 811 | move=> H5. 812 | rewrite - (CardPowNature T2 T1 C (Card T1)). 813 | apply (proj1 (Formula_66_1 (forall (t : T1), tf t) (T1 -> T2))). 814 | exists (fun (x : forall (t : T1), tf t) (t : T1) => proj1_sig (H4 t) (x t)). 815 | exists (fun (x : T1 -> T2) (t : T1) => proj1_sig (H5 t) (x t)). 816 | apply conj. 817 | move=> x. 818 | apply functional_extensionality_dep. 819 | move=> t. 820 | apply (proj1 (proj2_sig (H5 t)) (x t)). 821 | move=> y. 822 | apply functional_extensionality. 823 | move=> t. 824 | apply (proj2 (proj2_sig (H5 t)) (y t)). 825 | apply H3. 826 | apply (Formula_1_1 T1). 827 | move=> t. 828 | apply constructive_indefinite_description. 829 | apply (proj2_sig (H4 t)). 830 | move=> t. 831 | apply constructive_indefinite_description. 832 | apply (proj2 (Formula_66_1 (tf t) T2)). 833 | rewrite (H1 t). 834 | apply H2. 835 | rewrite H2. 836 | apply (Formula_1_1 T2). 837 | Qed. 838 | --------------------------------------------------------------------------------