├── .github ├── ISSUE_TEMPLATE.md └── PULL_REQUEST_TEMPLATE.md ├── .gitignore ├── Holmakefile ├── LICENSE ├── README.md ├── cf0Script.sml ├── cf1Script.sml ├── cf2Script.sml ├── cf3Script.sml ├── cf4Script.sml ├── cf5Script.sml ├── cf6Script.sml ├── cf7Script.sml ├── cf8Script.sml ├── cf9Script.sml ├── cfaScript.sml ├── cfbScript.sml ├── docs ├── code-of-conduct.md └── contributing.md ├── ex0Script.sml ├── ex1Script.sml ├── ex2Script.sml ├── ex4Script.sml ├── ex5Script.sml ├── ex6Script.sml ├── ex7Script.sml ├── ex9Script.sml ├── exaScript.sml ├── exbScript.sml ├── ffs ├── Holmakefile ├── factoredSetPolyScript.sml ├── factoredSetScript.sml └── partitionScript.sml ├── matrixLib.sml └── matrixScript.sml /.github/ISSUE_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | ## Expected Behavior 2 | 3 | 4 | ## Actual Behavior 5 | 6 | 7 | ## Steps to Reproduce the Problem 8 | 9 | 1. 10 | 1. 11 | 1. 12 | 13 | ## Specifications 14 | 15 | - Version: 16 | - Platform: -------------------------------------------------------------------------------- /.github/PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | Fixes # 2 | 3 | > It's a good idea to open an issue first for discussion. 4 | 5 | - [ ] Tests pass 6 | - [ ] Appropriate changes to README are included in PR -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Copyright 2020 Google LLC 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # https://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | *Theory.* 16 | .HOLMK 17 | .hollogs 18 | *.ui 19 | *.uo 20 | -------------------------------------------------------------------------------- /Holmakefile: -------------------------------------------------------------------------------- 1 | # Copyright 2021 DeepMind Technologies Limited. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # https://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | INCLUDES = $(HOLDIR)/examples/category $(HOLDIR)/examples/algebra/lib 16 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 22 | outstanding shares, or (iii) beneficial ownership of such entity. 23 | 24 | "You" (or "Your") shall mean an individual or Legal Entity 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | 179 | APPENDIX: How to apply the Apache License to your work. 180 | 181 | To apply the Apache License to your work, attach the following 182 | boilerplate notice, with the fields enclosed by brackets "[]" 183 | replaced with your own identifying information. (Don't include 184 | the brackets!) The text should be enclosed in the appropriate 185 | comment syntax for the file format. We also recommend that a 186 | file or class name and description of purpose be included on the 187 | same "printed page" as the copyright notice for easier 188 | identification within third-party archives. 189 | 190 | Copyright [yyyy] [name of copyright owner] 191 | 192 | Licensed under the Apache License, Version 2.0 (the "License"); 193 | you may not use this file except in compliance with the License. 194 | You may obtain a copy of the License at 195 | 196 | http://www.apache.org/licenses/LICENSE-2.0 197 | 198 | Unless required by applicable law or agreed to in writing, software 199 | distributed under the License is distributed on an "AS IS" BASIS, 200 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 201 | See the License for the specific language governing permissions and 202 | limitations under the License. 203 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Cartesian Frames in HOL 2 | 3 | This repository contains a formalisation in [HOL](https://hol-theorem-prover.org) of the results in the [Cartesian Frames sequence](https://www.alignmentforum.org/s/2A7rrZ4ySx6R8mfoT). 4 | 5 | The proofs have been checked to build with [this commit](https://github.com/HOL-Theorem-Prover/HOL/tree/c51de550191d516cb9dfe47c6a1e866b232f2c96) of the HOL theorem prover. 6 | They may also work in other versions, but beware that proof scripts can be fragile to changes in the underlying prover libraries. 7 | 8 | # Contents 9 | 10 | The theories are organised (for the most part) so that the general theorems from the {n+1}th blog post in the sequence are proved in the theory named `cfn` with specific examples formalised in the theory named `exn`. 11 | Thus for example the proof script for the first (subagent) decomposition theorem, which appears in the ninth blog post, is in `cf8Script.sml`. 12 | 13 | # Building the theories 14 | 15 | To check the proofs yourself: 16 | 17 | 1. Get the HOL theorem prover. 18 | For example, follow [the instructions](https://hol-theorem-prover.org/#get) on its website. 19 | (The extra details in the [CakeML build instructions](https://github.com/CakeML/cakeml/blob/master/build-instructions.sh) may be useful, but note that CakeML is not required for the Cartesian frames proofs.) 20 | 2. Run `Holmake` (or `$HOLDIR/bin/Holmake`) in this directory. 21 | To build only a specific theory (and its dependencies), for example `cf8`, run `Holmake cf8Theory`. 22 | 23 | # Interacting with and extending the theories 24 | 25 | HOL is an interactive theorem prover. 26 | Most of the value of this formalisation comes from interacting with it. 27 | Pointers for how to do this can be found on [HOL's website](https://hol-theorem-prover.org/#doc). 28 | -------------------------------------------------------------------------------- /cf0Script.sml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright 2021 DeepMind Technologies Limited. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | https://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | *) 16 | 17 | open HolKernel boolLib bossLib Parse 18 | pairTheory pred_setTheory arithmeticTheory stringTheory 19 | 20 | val _ = new_theory"cf0"; 21 | 22 | (* Cartesian Frames *) 23 | 24 | Datatype: 25 | cf = <| world: string set; 26 | agent: string set; 27 | env: string set; 28 | eval: string -> string -> string |> 29 | End 30 | 31 | (* 32 | We restrict attention to finite Cartesian frames so as to allow the category of 33 | Cartesian frames over W to include frames where, e.g., the agent is the set of 34 | functions whose domain is the agent of some other frame in the category. A 35 | category (at least according to categoryTheory) has a _set_ of objects. The 36 | collection of frames including those with all such sets of functions for 37 | agents, and where some agents are infinite, is too large to be a set. 38 | 39 | We also require c.world to be finite so ensureables etc. are finite too. This 40 | is important because, e.g., cf1 w s uses s as its environment and we sometimes 41 | want s to be something in ensure c. 42 | 43 | An alternative approach would be to axiomatise (or assume) an (uncountable) 44 | Grothendieck universe from which to draw the agents and environments for our 45 | frames. Our proofs should not be hard to fix if we need to switch to this 46 | approach. 47 | *) 48 | 49 | Definition finite_cf_def: 50 | finite_cf c ⇔ FINITE c.agent ∧ FINITE c.env ∧ FINITE c.world 51 | End 52 | 53 | Definition wf_def: 54 | wf c ⇔ 55 | (∀a e. a ∈ c.agent ∧ e ∈ c.env ⇒ c.eval a e ∈ c.world) ∧ 56 | (∀a e. a ∉ c.agent ∨ e ∉ c.env ⇒ c.eval a e = ARB) ∧ 57 | finite_cf c 58 | End 59 | 60 | Definition image_def: 61 | image c = { w | ∃a e. a ∈ c.agent ∧ e ∈ c.env ∧ c.eval a e = w } 62 | End 63 | 64 | Theorem finite_image[simp]: 65 | finite_cf c ⇒ FINITE (image c) 66 | Proof 67 | rw[image_def, finite_cf_def] 68 | \\ qspec_then`UNCURRY c.eval`irule (Q.GEN`f`FINITE_SURJ) 69 | \\ qexists_tac`c` 70 | \\ qexists_tac`c.agent × c.env` 71 | \\ simp[SURJ_DEF, FORALL_PROD, EXISTS_PROD] 72 | \\ metis_tac[] 73 | QED 74 | 75 | Definition mk_cf_def: 76 | mk_cf c = c with eval := λa e. if a ∈ c.agent ∧ e ∈ c.env then c.eval a e else ARB 77 | End 78 | 79 | Theorem mk_cf_components[simp]: 80 | (mk_cf c).world = c.world ∧ 81 | (mk_cf c).agent = c.agent ∧ 82 | (mk_cf c).env = c.env 83 | Proof 84 | rw[mk_cf_def] 85 | QED 86 | 87 | Theorem wf_mk_cf[simp]: 88 | wf (mk_cf c) ⇔ image c ⊆ c.world ∧ finite_cf c 89 | Proof 90 | rw[wf_def, SUBSET_DEF, image_def, mk_cf_def, finite_cf_def] 91 | \\ rw[EQ_IMP_THM] \\ rw[] 92 | \\ metis_tac[] 93 | QED 94 | 95 | (* Initial definition of controllables *) 96 | 97 | Definition ensure_def: 98 | ensure c = { s | s ⊆ c.world ∧ ∃a. a ∈ c.agent ∧ ∀e. e ∈ c.env ⇒ c.eval a e ∈ s } 99 | End 100 | 101 | Definition prevent_def: 102 | prevent c = { s | s ⊆ c.world ∧ ∃a. a ∈ c.agent ∧ ∀e. e ∈ c.env ⇒ c.eval a e ∉ s } 103 | End 104 | 105 | Definition ctrl_def: 106 | ctrl c = ensure c ∩ prevent c 107 | End 108 | 109 | Theorem ensure_empty_agent[simp]: 110 | c.agent = ∅ ⇒ (ensure c = {}) 111 | Proof 112 | rw[ensure_def] 113 | QED 114 | 115 | Theorem ensure_subset_pow[simp]: 116 | ensure c ⊆ POW c.world 117 | Proof 118 | rw[ensure_def, Once SUBSET_DEF, IN_POW] 119 | QED 120 | 121 | Theorem prevent_subset_pow[simp]: 122 | prevent c ⊆ POW c.world 123 | Proof 124 | rw[prevent_def, Once SUBSET_DEF, IN_POW] 125 | QED 126 | 127 | Theorem ctrl_subset_pow[simp]: 128 | ctrl c ⊆ POW c.world 129 | Proof 130 | rw[ctrl_def] 131 | \\ mp_tac ensure_subset_pow 132 | \\ rewrite_tac[SUBSET_DEF] 133 | \\ simp[] 134 | QED 135 | 136 | Theorem finite_ensure[simp]: 137 | finite_cf c ⇒ FINITE (ensure c) 138 | Proof 139 | rw[finite_cf_def] 140 | \\ irule SUBSET_FINITE 141 | \\ qexists_tac`POW (c.world)` 142 | \\ simp[] 143 | QED 144 | 145 | Theorem finite_prevent[simp]: 146 | finite_cf c ⇒ FINITE (prevent c) 147 | Proof 148 | rw[finite_cf_def] 149 | \\ irule SUBSET_FINITE 150 | \\ qexists_tac`POW (c.world)` 151 | \\ simp[] 152 | QED 153 | 154 | Theorem finite_ctrl[simp]: 155 | finite_cf c ⇒ FINITE (ctrl c) 156 | Proof 157 | rw[finite_cf_def] 158 | \\ irule SUBSET_FINITE 159 | \\ qexists_tac`POW (c.world)` 160 | \\ simp[] 161 | QED 162 | 163 | Theorem ctrl_closure: 164 | c.world = c'.world ∧ c.agent ⊆ c'.agent ∧ c'.env ⊆ c.env ∧ 165 | (∀a e. a ∈ c.agent ∧ e ∈ c'.env ⇒ c'.eval a e = c.eval a e) ⇒ 166 | ensure c ⊆ ensure c' ∧ prevent c ⊆ prevent c' ∧ ctrl c ⊆ ctrl c' 167 | Proof 168 | rw[ensure_def, prevent_def, ctrl_def, SUBSET_DEF] \\ metis_tac[] 169 | QED 170 | 171 | Theorem ensure_superset: 172 | s1 ⊆ s2 ∧ s2 ⊆ c.world ∧ s1 ∈ ensure c ⇒ s2 ∈ ensure c 173 | Proof 174 | rw[ensure_def, SUBSET_DEF] \\ metis_tac[] 175 | QED 176 | 177 | Theorem prevent_subset: 178 | s1 ⊆ s2 ∧ s2 ⊆ c.world ∧ s2 ∈ prevent c ⇒ s2 ∈ prevent c 179 | Proof 180 | rw[prevent_def, SUBSET_DEF] \\ metis_tac[] 181 | QED 182 | 183 | Definition sup_closure_def: 184 | sup_closure u sos = { s | s ⊆ u ∧ ∃t. t ∈ sos ∧ t ⊆ s } 185 | End 186 | 187 | Definition sub_closure_def: 188 | sub_closure u sos = { s | s ⊆ u ∧ ∃t. t ∈ sos ∧ s ⊆ t } 189 | End 190 | 191 | Definition union_closure_def: 192 | union_closure sos = { BIGUNION s | s ⊆ sos } 193 | End 194 | 195 | Theorem union_closure_sing: 196 | union_closure {s} = {{}; s} 197 | Proof 198 | rw[union_closure_def] 199 | \\ rw[Once EXTENSION] 200 | \\ Cases_on`x = {}` \\ fs[] >- (qexists_tac`{}` \\ simp[]) 201 | \\ Cases_on`x = s` \\ fs[] >- (qexists_tac`{s}` \\ fs[]) 202 | \\ qx_gen_tac`b` 203 | \\ Cases_on`b = {s}` \\ fs[] 204 | \\ reverse(Cases_on` b PSUBSET {s}`) >- fs[PSUBSET_DEF] 205 | \\ fs[PSUBSET_SING] 206 | QED 207 | 208 | Theorem union_closure_empty[simp]: 209 | union_closure ∅ = {∅} 210 | Proof 211 | rw[union_closure_def] 212 | \\ rw[Once EXTENSION] 213 | QED 214 | 215 | Theorem union_closure_insert: 216 | union_closure (x INSERT ss) = 217 | IMAGE ((UNION) x) (union_closure ss) ∪ union_closure ss 218 | Proof 219 | rw[union_closure_def, Once EXTENSION] 220 | \\ rw[EQ_IMP_THM] 221 | >- ( 222 | reverse(Cases_on`x ∈ s` \\ fs[]) >- metis_tac[] 223 | \\ disj1_tac 224 | \\ simp[PULL_EXISTS] 225 | \\ qexists_tac`s DELETE x` 226 | \\ fs[SUBSET_DEF] 227 | \\ reverse conj_tac >- metis_tac[] 228 | \\ simp[Once EXTENSION] 229 | \\ metis_tac[]) 230 | >- ( 231 | qexists_tac`x INSERT s` 232 | \\ simp[] \\ fs[SUBSET_DEF] ) 233 | \\ qexists_tac`s` 234 | \\ fs[SUBSET_DEF] 235 | QED 236 | 237 | (* Initial definition of observables *) 238 | 239 | Definition ifs_def: 240 | ifs c s a0 a1 = 241 | { a | a ∈ c.agent ∧ ∀e. e ∈ c.env ⇒ 242 | (c.eval a e ∈ s ⇒ c.eval a e = c.eval a0 e) ∧ 243 | (c.eval a e ∉ s ⇒ c.eval a e = c.eval a1 e) } 244 | End 245 | 246 | Theorem ifs_compl: 247 | s ⊆ c.world ∧ wf c⇒ 248 | ifs c s a0 a1 = ifs c (c.world DIFF s) a1 a0 249 | Proof 250 | rw[ifs_def, wf_def] 251 | \\ fs[SUBSET_DEF] 252 | \\ rw[Once EXTENSION] 253 | \\ metis_tac[] 254 | QED 255 | 256 | Theorem ifs_same[simp]: 257 | a ∈ c.agent ⇒ a ∈ ifs c s a a 258 | Proof 259 | rw[ifs_def] 260 | QED 261 | 262 | Definition obs_def: 263 | obs c = { s | s ⊆ c.world ∧ ∀a0 a1. a0 ∈ c.agent ∧ a1 ∈ c.agent ⇒ 264 | ∃a. a ∈ ifs c s a0 a1 } 265 | End 266 | 267 | Theorem obs_compl: 268 | wf c ∧ s ∈ obs c ⇒ c.world DIFF s ∈ obs c 269 | Proof 270 | rw[obs_def] \\ rw[GSYM ifs_compl] 271 | QED 272 | 273 | Theorem obs_union: 274 | s ∈ obs c ∧ t ∈ obs c ⇒ s ∪ t ∈ obs c 275 | Proof 276 | rw[obs_def] 277 | \\ `∃a2. a2 ∈ ifs c s a0 a1` by metis_tac[] 278 | \\ `a2 ∈ c.agent` by fs[ifs_def] 279 | \\ `∃a3. a3 ∈ ifs c t a0 a2` by metis_tac[] 280 | \\ qexists_tac`a3` \\ rw[] 281 | \\ fs[ifs_def] 282 | \\ metis_tac[] 283 | QED 284 | 285 | Theorem obs_inter: 286 | wf c ∧ s ∈ obs c ∧ t ∈ obs c ⇒ s ∩ t ∈ obs c 287 | Proof 288 | strip_tac 289 | \\ imp_res_tac obs_compl 290 | \\ `s ⊆ c.world ∧ t ⊆ c.world` by fs[obs_def] 291 | \\ `s ∩ t = c.world DIFF ((c.world DIFF s) ∪ (c.world DIFF t))` by ( 292 | rw[EXTENSION] \\ fs[SUBSET_DEF] \\ metis_tac[] ) 293 | \\ pop_assum SUBST1_TAC 294 | \\ match_mp_tac obs_compl \\ fs[] 295 | \\ match_mp_tac obs_union \\ fs[] 296 | QED 297 | 298 | Theorem obs_closure: 299 | c'.env ⊆ c.env ∧ c'.world = c.world ∧ c'.agent = c.agent ∧ 300 | (∀a e. a ∈ c.agent ∧ e ∈ c'.env ⇒ c'.eval a e = c.eval a e) ⇒ 301 | obs c ⊆ obs c' 302 | Proof 303 | rw[obs_def, SUBSET_DEF] 304 | \\ first_x_assum (qspecl_then[`a0`,`a1`]mp_tac) 305 | \\ rw[] 306 | \\ fs[ifs_def] 307 | \\ metis_tac[] 308 | QED 309 | 310 | Theorem obs_empty: 311 | {} ∈ obs c 312 | Proof 313 | rw[obs_def, ifs_def] 314 | \\ qexists_tac`a1` \\ rw[] 315 | QED 316 | 317 | Theorem obs_world: 318 | wf c ⇒ c.world ∈ obs c 319 | Proof 320 | rw[obs_def, ifs_def, wf_def] 321 | \\ metis_tac[] 322 | QED 323 | 324 | Theorem union_closure_SUBSET_obs: 325 | FINITE s ⇒ 326 | (union_closure s ⊆ obs c ⇔ s ⊆ obs c) 327 | Proof 328 | rw[EQ_IMP_THM] 329 | >- ( 330 | fs[union_closure_def, Once SUBSET_DEF, PULL_EXISTS] 331 | \\ rw[] 332 | \\ first_x_assum(qspec_then`{x}`mp_tac) 333 | \\ simp[SUBSET_DEF] ) 334 | \\ rpt (pop_assum mp_tac) 335 | \\ qid_spec_tac`s` 336 | \\ ho_match_mp_tac FINITE_INDUCT 337 | \\ rw[obs_empty] 338 | \\ simp[union_closure_insert] 339 | \\ fs[SUBSET_DEF, PULL_EXISTS] 340 | \\ metis_tac[obs_union] 341 | QED 342 | 343 | Definition env_for_def: 344 | env_for c s = { e | e ∈ c.env ∧ ∀a. a ∈ c.agent ⇒ c.eval a e ∈ s } 345 | End 346 | 347 | Theorem finite_env_for[simp]: 348 | finite_cf c ⇒ FINITE (env_for c s) 349 | Proof 350 | rw[finite_cf_def] 351 | \\ irule SUBSET_FINITE 352 | \\ qexists_tac`c.env` 353 | \\ simp[SUBSET_DEF, env_for_def] 354 | QED 355 | 356 | Theorem obs_env_for: 357 | wf c ∧ s ∈ obs c ⇒ ∀e. e ∈ c.env ⇒ e ∈ env_for c s ∨ e ∈ env_for c (c.world DIFF s) 358 | Proof 359 | rpt strip_tac 360 | \\ CCONTR_TAC \\ fs[] 361 | \\ `∃a0. a0 ∈ c.agent ∧ c.eval a0 e ∉ s` 362 | by ( fs[env_for_def] \\ fs[] \\ metis_tac[] ) 363 | \\ `∃a1. a1 ∈ c.agent ∧ c.eval a1 e ∈ s` 364 | by ( fs[wf_def, env_for_def] \\ fs[] \\ metis_tac[] ) 365 | \\ `∃a. a ∈ ifs c s a0 a1` by fs[obs_def] 366 | \\ Cases_on`c.eval a e ∈ s` 367 | \\ fs[env_for_def] \\ fs[ifs_def] \\ metis_tac[] 368 | QED 369 | 370 | Theorem env_for_compl_disjoint: 371 | c.agent ≠ ∅ ⇒ 372 | DISJOINT (env_for c s) (env_for c (c.world DIFF s)) 373 | Proof 374 | rw[IN_DISJOINT, env_for_def] \\ metis_tac[MEMBER_NOT_EMPTY] 375 | QED 376 | 377 | Theorem ctrl_obs_disjoint: 378 | wf c ∧ c.env ≠ {} ⇒ DISJOINT (ctrl c) (obs c) 379 | Proof 380 | simp[IN_DISJOINT] 381 | \\ strip_tac 382 | \\ imp_res_tac obs_env_for 383 | \\ qx_gen_tac`s` 384 | \\ CCONTR_TAC \\ fs[] 385 | \\ `∃e. e ∈ c.env` by (Cases_on`c.env` \\ fs[] \\ metis_tac[]) 386 | \\ `s ∈ prevent c ∧ s ∈ ensure c` by fs[ctrl_def] 387 | \\ `∃a0. a0 ∈ c.agent ∧ c.eval a0 e ∉ s` by (fs[prevent_def] \\ metis_tac[]) 388 | \\ `∃a1. a1 ∈ c.agent ∧ c.eval a1 e ∈ s` by (fs[ensure_def] \\ metis_tac[]) 389 | \\ fs[env_for_def, wf_def] 390 | \\ metis_tac[] 391 | QED 392 | 393 | Theorem image_subset_ensure_inter_obs: 394 | wf c ⇒ 395 | (s ∈ ensure c ∩ obs c ⇔ image c ⊆ s ∧ c.agent ≠ {} ∧ s ⊆ c.world) 396 | Proof 397 | strip_tac 398 | \\ reverse EQ_TAC 399 | >- ( 400 | strip_tac 401 | \\ simp[] 402 | \\ reverse conj_asm2_tac 403 | >- ( 404 | fs[obs_def, image_def, wf_def] 405 | \\ rpt strip_tac 406 | \\ qexists_tac`a0` 407 | \\ simp[ifs_def] 408 | \\ fsrw_tac[][SUBSET_DEF] 409 | \\ metis_tac[]) 410 | \\ simp[ensure_def] 411 | \\ Cases_on`c.agent` \\ fs[] 412 | \\ qexists_tac`x` 413 | \\ simp[] 414 | \\ fs[image_def, SUBSET_DEF, wf_def] 415 | \\ metis_tac[] ) 416 | \\ strip_tac 417 | \\ Cases_on`c.agent = {}` 418 | >- fs[ensure_def] 419 | \\ fs[image_def] 420 | \\ reverse conj_tac 421 | >- fs[SUBSET_DEF, obs_def] 422 | \\ CCONTR_TAC \\ fs[SUBSET_DEF] 423 | \\ fs[ensure_def] 424 | \\ first_assum(mp_then Any mp_tac obs_env_for) 425 | \\ simp[] 426 | \\ goal_assum(first_assum o mp_then Any mp_tac) 427 | \\ simp[env_for_def] 428 | \\ fs[wf_def] 429 | \\ metis_tac[] 430 | QED 431 | 432 | Theorem ensure_inter_obs: 433 | wf c ∧ c.agent ≠ ∅ ⇒ ensure c ∩ obs c = sup_closure c.world {image c} 434 | Proof 435 | strip_tac 436 | \\ rewrite_tac[EXTENSION] 437 | \\ simp[image_subset_ensure_inter_obs] 438 | \\ simp[sup_closure_def] 439 | \\ metis_tac[] 440 | QED 441 | 442 | Theorem small_agent_large_obs: 443 | FINITE c.agent ∧ CARD c.agent ≤ 1 ⇒ obs c = POW c.world 444 | Proof 445 | strip_tac 446 | \\ Cases_on`c.agent` \\ rfs[CARD_INSERT] 447 | >- ( simp[obs_def, POW_DEF] ) 448 | \\ reverse(Cases_on`t` \\ rfs[ADD1, CARD_INSERT]) 449 | >- ( qpat_x_assum`_ ≤ 1`mp_tac \\ rw[] ) 450 | \\ simp[obs_def] 451 | \\ `x ∈ c.agent` by fs[] 452 | \\ simp[EXTENSION, IN_POW, PULL_EXISTS] 453 | \\ metis_tac[ifs_same] 454 | QED 455 | 456 | Theorem empty_env_large_ctrl: 457 | c.agent ≠ ∅ ∧ c.env = ∅ ⇒ 458 | ctrl c = POW c.world ∧ 459 | prevent c = POW c.world ∧ 460 | ensure c = POW c.world 461 | Proof 462 | strip_tac 463 | \\ conj_asm2_tac 464 | \\ simp[ctrl_def] 465 | \\ simp[prevent_def, ensure_def, MEMBER_NOT_EMPTY] 466 | \\ simp[EXTENSION, IN_POW] 467 | QED 468 | 469 | Theorem small_env_large_ctrl: 470 | wf c ∧ c.agent ≠ ∅ ∧ c.env = {e} ⇒ 471 | ctrl c = { s | s ⊆ c.world ∧ ¬DISJOINT s (image c) ∧ ¬DISJOINT (c.world DIFF s) (image c) } ∧ 472 | ensure c = { s | s ⊆ c.world ∧ ¬DISJOINT s (image c) } ∧ 473 | prevent c = { s | s ⊆ c.world ∧ ¬DISJOINT (c.world DIFF s) (image c) } 474 | Proof 475 | strip_tac 476 | \\ conj_asm2_tac 477 | \\ simp[ctrl_def] 478 | >- ( 479 | simp[EXTENSION] 480 | \\ fs[IN_DISJOINT, SUBSET_DEF] 481 | \\ metis_tac[]) 482 | \\ fs[GSYM MEMBER_NOT_EMPTY] 483 | \\ simp[ensure_def, prevent_def] 484 | \\ simp[EXTENSION, GSYM FORALL_AND_THM] 485 | \\ qx_gen_tac`s` 486 | \\ Cases_on`s ⊆ c.world` \\ fs[] 487 | \\ fs[SUBSET_DEF] 488 | \\ simp[IN_DISJOINT, SUBSET_DEF, image_def] 489 | \\ conj_tac >- metis_tac[] 490 | \\ reverse(rw[EQ_IMP_THM]) 491 | >- metis_tac[] 492 | \\ fs[wf_def] 493 | \\ rw[PULL_EXISTS] 494 | \\ metis_tac[] 495 | QED 496 | 497 | val _ = export_theory(); 498 | -------------------------------------------------------------------------------- /cf3Script.sml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright 2021 DeepMind Technologies Limited. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | https://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | *) 16 | 17 | open HolKernel boolLib bossLib Parse dep_rewrite 18 | pred_setTheory pairTheory categoryTheory 19 | cf0Theory cf1Theory cf2Theory 20 | 21 | val _ = new_theory"cf3"; 22 | 23 | Theorem ensure_cf1_morphism: 24 | (s ∈ ensure c ⇔ s ⊆ c.world ∧ ∃m. is_chu_morphism (cf1 c.world s) c m) 25 | Proof 26 | rw[ensure_def, is_chu_morphism_def] 27 | \\ Cases_on`s ⊆ c.world` \\ simp[] 28 | \\ simp[extensional_def, cf1_def, mk_cf_def] 29 | \\ rw[EQ_IMP_THM] 30 | >- ( 31 | qexists_tac`<| map_agent := λx. if x = "" then a else ARB; 32 | map_env := λe. if e ∈ c.env then c.eval a e else ARB |>` 33 | \\ rw[] \\ fs[SUBSET_DEF] \\ metis_tac[] ) 34 | \\ qexists_tac`m.map_agent ""` \\ rw[] 35 | \\ metis_tac[] 36 | QED 37 | 38 | Theorem prevent_cf1_morphism: 39 | c ∈ chu_objects w ⇒ 40 | (s ∈ prevent c ⇔ s ⊆ w ∧ ∃m. is_chu_morphism (cf1 w (w DIFF s)) c m) 41 | Proof 42 | rw[chu_objects_def] 43 | \\ reverse(Cases_on`s ⊆ c.world` \\ simp[]) 44 | >- simp[prevent_def] 45 | \\ `s ∈ prevent c ⇔ c.world DIFF s ∈ ensure c` 46 | by ( 47 | rw[prevent_def, ensure_def] 48 | \\ fs[SUBSET_DEF, wf_def] 49 | \\ metis_tac[] ) 50 | \\ pop_assum SUBST1_TAC 51 | \\ rw[ensure_cf1_morphism] 52 | QED 53 | 54 | Theorem ensure_morphism_mono: 55 | m :- c → d -: chu w ⇒ ensure c ⊆ ensure d 56 | Proof 57 | rw[SUBSET_DEF] 58 | \\ fs[ensure_cf1_morphism] 59 | \\ qmatch_assum_rename_tac`is_chu_morphism _ c f1` 60 | \\ imp_res_tac maps_to_obj \\ fs[] 61 | \\ `w = c.world ∧ w = d.world` by fs[chu_objects_def] 62 | \\ `FINITE w` by metis_tac[in_chu_objects_finite_world] 63 | \\ qabbrev_tac`m1 = <| dom := cf1 w x; cod := c; map := f1 |>` 64 | \\ `m1 :- cf1 w x → c -: chu w` 65 | by ( simp[maps_to_in_def, Abbr`m1`] \\ fs[pre_chu_def] \\ rfs[]) 66 | \\ `m o m1 -: chu w :- cf1 w x → d -: chu w` by ( 67 | imp_res_tac maps_to_comp \\ fs[] ) 68 | \\ fs[maps_to_in_def, pre_chu_def] 69 | \\ metis_tac[] 70 | QED 71 | 72 | Theorem ensure_prod: 73 | c ∈ chu_objects w ∧ d ∈ chu_objects w ⇒ 74 | (ensure (c && d) = ensure c ∩ ensure d) 75 | Proof 76 | strip_tac 77 | \\ simp[EXTENSION] 78 | \\ simp[ensure_cf1_morphism] 79 | \\ gen_tac 80 | \\ `c.world = w ∧ d.world = w` by fs[chu_objects_def] 81 | \\ `FINITE w` by metis_tac[in_chu_objects_finite_world] 82 | \\ Cases_on`x ⊆ c.world` \\ rfs[] 83 | \\ simp[EQ_IMP_THM] 84 | \\ conj_tac 85 | >- ( 86 | strip_tac 87 | \\ `<| dom := cf1 w x; cod := c && d; map := m|> :- cf1 w x → c && d -: chu w` 88 | by ( simp[maps_to_in_def, pre_chu_def] ) 89 | \\ qspecl_then[`c`,`d`]mp_tac(Q.GENL[`a`,`b`]proj_maps_to) 90 | \\ impl_tac >- simp[] \\ strip_tac 91 | \\ imp_res_tac maps_to_comp 92 | \\ rpt(first_x_assum(qspec_then`ARB`kall_tac)) \\ fs[] 93 | \\ fs[maps_to_in_def, pre_chu_def] 94 | \\ metis_tac[] ) 95 | \\ simp[PULL_EXISTS] 96 | \\ qx_genl_tac[`m1`,`m2`] 97 | \\ strip_tac 98 | \\ `<| dom := cf1 w x; cod := c; map := m1|> :- cf1 w x → c -: chu w` 99 | by ( simp[maps_to_in_def, pre_chu_def] ) 100 | \\ `<| dom := cf1 w x; cod := d; map := m2|> :- cf1 w x → d -: chu w` 101 | by ( simp[maps_to_in_def, pre_chu_def] ) 102 | \\ `∃p. p :- cf1 w x → c && d -: chu w` by metis_tac[prod_is_prod, EXISTS_UNIQUE_THM] 103 | \\ fs[maps_to_in_def, pre_chu_def] 104 | \\ metis_tac[] 105 | QED 106 | 107 | Theorem ensure_sum: 108 | c ∈ chu_objects w ∧ d ∈ chu_objects w ∧ c ≠ null w ∧ d ≠ null w ⇒ 109 | ensure (sum c d) = ensure c ∪ ensure d 110 | Proof 111 | strip_tac 112 | \\ Cases_on`c.env = ∅` 113 | >- ( 114 | Cases_on`c.agent = ∅` 115 | >- ( 116 | `c = null w` by ( 117 | simp_tac std_ss [cf_component_equality] 118 | \\ simp[null_def] 119 | \\ fs[chu_objects_def, wf_def] 120 | \\ simp[FUN_EQ_THM] ) 121 | \\ fs[] ) 122 | \\ `ensure c ∪ ensure d = POW w` 123 | by ( 124 | simp[EXTENSION, IN_POW] 125 | \\ simp[ensure_def] 126 | \\ fs[chu_objects_def] 127 | \\ metis_tac[MEMBER_NOT_EMPTY] ) 128 | \\ `ensure (sum c d) = POW w` 129 | by ( 130 | simp[EXTENSION, IN_POW] 131 | \\ simp[ensure_def, PULL_EXISTS] 132 | \\ simp[sum_def] 133 | \\ fs[chu_objects_def] 134 | \\ metis_tac[MEMBER_NOT_EMPTY] ) 135 | \\ simp[] ) 136 | \\ Cases_on`d.env = ∅` 137 | >- ( 138 | Cases_on`d.agent = ∅` 139 | >- ( 140 | `d = null w` by ( 141 | simp_tac std_ss [cf_component_equality] 142 | \\ simp[null_def] 143 | \\ fs[chu_objects_def, wf_def] 144 | \\ simp[FUN_EQ_THM] ) 145 | \\ fs[] ) 146 | \\ `ensure c ∪ ensure d = POW w` 147 | by ( 148 | simp[EXTENSION, IN_POW] 149 | \\ simp[ensure_def] 150 | \\ fs[chu_objects_def] 151 | \\ metis_tac[MEMBER_NOT_EMPTY] ) 152 | \\ `ensure (sum c d) = POW w` 153 | by ( 154 | simp[EXTENSION, IN_POW] 155 | \\ simp[ensure_def, PULL_EXISTS] 156 | \\ simp[sum_def] 157 | \\ fs[chu_objects_def] 158 | \\ metis_tac[MEMBER_NOT_EMPTY] ) 159 | \\ simp[] ) 160 | \\ once_rewrite_tac[SET_EQ_SUBSET] 161 | \\ `c.world = w ∧ d.world = w ∧ (sum c d).world = w` 162 | by ( simp[sum_def] \\ fs[chu_objects_def] ) 163 | \\ `FINITE w` by metis_tac[in_chu_objects_finite_world] 164 | \\ reverse conj_tac 165 | >- ( 166 | simp[Once SUBSET_DEF, ensure_cf1_morphism] 167 | \\ simp[Once SUBSET_DEF, SimpR``(/\)``] 168 | \\ simp[ensure_cf1_morphism] 169 | \\ conj_tac \\ gen_tac \\ strip_tac 170 | \\ pop_assum(mp_then Any mp_tac is_chu_morphism_maps_to) 171 | \\ disch_then(qspec_then`w`mp_tac) \\ simp[] \\ strip_tac 172 | \\ metis_tac[cf1_in_chu_objects, inj_maps_to, maps_to_comp, 173 | is_category_chu, maps_to_in_chu] ) 174 | \\ simp[SUBSET_DEF] 175 | \\ simp[ensure_cf1_morphism] 176 | \\ gen_tac \\ strip_tac 177 | \\ fs[is_chu_morphism_def, extensional_def] 178 | \\ qpat_x_assum`_ ∈ _.agent`mp_tac 179 | \\ simp[Once sum_def] 180 | \\ simp[PULL_EXISTS] 181 | \\ strip_tac 182 | \\ qmatch_assum_rename_tac`z ∈ _.agent` 183 | >- ( 184 | disj1_tac 185 | \\ fs[sum_def, mk_cf_def, EXISTS_PROD, sum_eval_def, PULL_EXISTS] 186 | \\ qexists_tac`<| map_agent := restrict (K z) {""}; 187 | map_env := restrict (m.map_env o (λp1. encode_pair (p1, CHOICE d.env))) c.env |>` 188 | \\ simp[restrict_def] 189 | \\ metis_tac[CHOICE_DEF]) 190 | \\ disj2_tac 191 | \\ fs[sum_def, mk_cf_def, EXISTS_PROD, sum_eval_def, PULL_EXISTS] 192 | \\ qexists_tac`<| map_agent := restrict (K z) {""}; 193 | map_env := restrict (m.map_env o (λp2. encode_pair (CHOICE c.env, p2))) d.env |>` 194 | \\ simp[restrict_def] 195 | \\ metis_tac[CHOICE_DEF] 196 | QED 197 | 198 | Theorem ensure_sum_null: 199 | c.world = w ∧ c.agent ≠ ∅ ⇒ 200 | ensure (sum (null w) c) = POW w 201 | Proof 202 | rw[GSYM MEMBER_NOT_EMPTY, ensure_def, sum_def] 203 | \\ rw[EXTENSION, IN_POW] 204 | QED 205 | 206 | Theorem homotopy_equiv_ensure: 207 | c ≃ d -: w ⇒ ensure c = ensure d 208 | Proof 209 | rw[homotopy_equiv_def] 210 | \\ simp[EXTENSION, ensure_cf1_morphism] 211 | \\ imp_res_tac maps_to_obj \\ fs[] 212 | \\ `c.world = w ∧ d.world = w` by fs[chu_objects_def] \\ fs[] 213 | \\ `FINITE w` by metis_tac[in_chu_objects_finite_world] 214 | \\ gen_tac \\ EQ_TAC \\ strip_tac \\ simp[] 215 | \\ pop_assum(mp_then Any (qspec_then`w`mp_tac) is_chu_morphism_maps_to) 216 | \\ simp[] 217 | \\ metis_tac[maps_to_in_chu, maps_to_comp, cf1_in_chu_objects, is_category_chu] 218 | QED 219 | 220 | Theorem ensure_prevent_swap_disjoint: 221 | DISJOINT (ensure c) (prevent (swap c)) 222 | Proof 223 | rw[ensure_def, prevent_def, IN_DISJOINT] 224 | \\ metis_tac[] 225 | QED 226 | 227 | Definition cf2_def: 228 | cf2 w s = sum (cf1 w s) (cf1 w (w DIFF s)) 229 | End 230 | 231 | (* TODO: example of cf2 for a particular w and s *) 232 | 233 | Theorem ctrl_cf2_morphism: 234 | c ∈ chu_objects w ⇒ 235 | (s ∈ ctrl c ⇔ s ⊆ w ∧ ∃m. is_chu_morphism (cf2 w s) c m) 236 | Proof 237 | rw[ctrl_def, ensure_cf1_morphism] 238 | \\ rw[UNDISCH prevent_cf1_morphism] 239 | \\ `c.world = w` by fs[chu_objects_def] \\ fs[] 240 | \\ `FINITE w` by metis_tac[in_chu_objects_finite_world] 241 | \\ simp[cf2_def] 242 | \\ Cases_on`s ⊆ w` \\ simp[] 243 | \\ EQ_TAC \\ strip_tac 244 | \\ rpt(first_x_assum(mp_then (Pos(el 3)) (qspec_then`w`mp_tac) is_chu_morphism_maps_to)) 245 | \\ simp[] 246 | \\ PROVE_TAC[sum_is_sum, inj_maps_to, cf1_in_chu_objects, DIFF_SUBSET, 247 | is_category_chu, EXISTS_UNIQUE_THM, maps_to_comp, maps_to_in_chu] 248 | QED 249 | 250 | Theorem prevent_ensure_compl: 251 | c ∈ chu_objects w ∧ s ⊆ w ⇒ (s ∈ prevent c ⇔ w DIFF s ∈ ensure c) 252 | Proof 253 | rw[prevent_def, chu_objects_def, wf_def, ensure_def, SUBSET_DEF] 254 | \\ metis_tac[] 255 | QED 256 | 257 | Theorem ctrl_ensure_compl: 258 | c ∈ chu_objects w ⇒ 259 | (s ∈ ctrl c ⇔ s ∈ ensure c ∧ (w DIFF s) ∈ ensure c) 260 | Proof 261 | rw[ctrl_def] 262 | \\ reverse(Cases_on`s ⊆ w`) >- fs[ensure_def, chu_objects_def] 263 | \\ metis_tac[prevent_ensure_compl] 264 | QED 265 | 266 | Theorem ctrl_morphism_mono: 267 | m :- c → d -: chu w ⇒ ctrl c ⊆ ctrl d 268 | Proof 269 | rw[SUBSET_DEF] 270 | \\ imp_res_tac maps_to_obj \\ fs[] 271 | \\ rpt(first_x_assum (mp_then Any strip_assume_tac ctrl_ensure_compl)) 272 | \\ fs[] 273 | \\ imp_res_tac ensure_morphism_mono 274 | \\ fs[SUBSET_DEF] 275 | QED 276 | 277 | Theorem ctrl_prod: 278 | c ∈ chu_objects w ∧ d ∈ chu_objects w ⇒ 279 | ctrl (c && d) = ctrl c ∩ ctrl d 280 | Proof 281 | rw[EXTENSION] 282 | \\ last_assum (mp_then Any (first_assum o mp_then Any strip_assume_tac) prod_in_chu_objects) 283 | \\ EVERY_ASSUM (mp_then Any strip_assume_tac ctrl_ensure_compl) 284 | \\ fs[] 285 | \\ DEP_REWRITE_TAC[ensure_prod] 286 | \\ simp[] 287 | \\ metis_tac[] 288 | QED 289 | 290 | Theorem homotopy_equiv_ctrl: 291 | c ≃ d -: w ⇒ ctrl c = ctrl d 292 | Proof 293 | rw[EXTENSION] 294 | \\ `c ∈ chu_objects w ∧ d ∈ chu_objects w` by ( 295 | fs[homotopy_equiv_def] 296 | \\ imp_res_tac maps_to_obj 297 | \\ fs[] ) 298 | \\ DEP_REWRITE_TAC[ctrl_ensure_compl] 299 | \\ simp[] 300 | \\ metis_tac[homotopy_equiv_ensure] 301 | QED 302 | 303 | Theorem obs_homotopy_equiv: 304 | c ≃ d -: w ⇒ obs c = obs d 305 | Proof 306 | `∀c d. c ≃ d -: w ⇒ obs c ⊆ obs d` 307 | suffices_by metis_tac[homotopy_equiv_sym, SET_EQ_SUBSET] 308 | \\ rw[homotopy_equiv_def, SUBSET_DEF] 309 | \\ fs[obs_def] 310 | \\ imp_res_tac maps_to_obj \\ fs[] 311 | \\ `c.world = w ∧ d.world = w` by fs[chu_objects_def] \\ fs[] 312 | \\ rpt gen_tac \\ strip_tac 313 | \\ first_x_assum(qspecl_then[`g.map.map_agent a0`,`g.map.map_agent a1`]mp_tac) 314 | \\ impl_keep_tac >- fs[maps_to_in_chu, is_chu_morphism_def] 315 | \\ disch_then(qx_choose_then`a`strip_assume_tac) 316 | \\ qexists_tac`f.map.map_agent a` 317 | \\ fs[ifs_def] 318 | \\ conj_asm1_tac >- fs[maps_to_in_chu, is_chu_morphism_def] 319 | \\ qx_gen_tac`e` \\ strip_tac 320 | \\ first_x_assum(qspec_then`f.map.map_env e`mp_tac) 321 | \\ impl_keep_tac >- fs[maps_to_in_chu, is_chu_morphism_def] 322 | \\ strip_tac 323 | \\ qabbrev_tac`fA = f.map.map_agent` 324 | \\ qabbrev_tac`fE = f.map.map_env` 325 | \\ qabbrev_tac`gA = g.map.map_agent` 326 | \\ qabbrev_tac`gE = g.map.map_env` 327 | \\ rpt(qhdtm_x_assum`homotopic`mp_tac) 328 | \\ imp_res_tac maps_to_comp \\ fs[] 329 | \\ simp[homotopic_def, pre_chu_def] 330 | \\ imp_res_tac (#1(EQ_IMP_RULE maps_to_in_chu)) \\ fs[] 331 | \\ simp[hom_comb_def] 332 | \\ simp[chu_id_morphism_map_def] 333 | \\ DEP_REWRITE_TAC[compose_in_thm] 334 | \\ DEP_REWRITE_TAC[compose_thm] 335 | \\ simp[composable_in_def, pre_chu_def] 336 | \\ simp[is_chu_morphism_def] 337 | \\ strip_tac 338 | \\ pop_assum(strip_assume_tac o GSYM) 339 | \\ strip_tac 340 | \\ pop_assum(strip_assume_tac o GSYM) 341 | \\ fs[restrict_def] 342 | \\ qhdtm_x_assum`is_chu_morphism`mp_tac 343 | \\ qhdtm_x_assum`is_chu_morphism`mp_tac 344 | \\ simp[is_chu_morphism_def] 345 | \\ metis_tac[] 346 | QED 347 | 348 | Theorem image_compl_obs_prod: 349 | c1 ∈ chu_objects w ∧ c2 ∈ chu_objects w ∧ s ⊆ w ∧ 350 | image c1 ⊆ s ∧ image c2 ⊆ w DIFF s ⇒ s ∈ obs (c1 && c2) 351 | Proof 352 | rw[obs_def] 353 | >- fs[chu_objects_def] 354 | \\ simp[ifs_def] 355 | \\ qexists_tac`encode_pair (FST(decode_pair a0), SND(decode_pair a1))` 356 | \\ conj_asm1_tac >- fs[prod_def] 357 | \\ gen_tac 358 | \\ simp[Once prod_def, PULL_EXISTS] 359 | \\ fs[image_def, SUBSET_DEF, PULL_EXISTS] 360 | \\ pop_assum mp_tac 361 | \\ simp[prod_def, mk_cf_def, EXISTS_PROD, PULL_EXISTS] 362 | \\ strip_tac 363 | \\ simp[sum_eval_def] 364 | \\ strip_tac \\ rw[] 365 | \\ rfs[prod_def, EXISTS_PROD] 366 | \\ metis_tac[] 367 | QED 368 | 369 | Theorem obs_homotopy_equiv_prod: 370 | c ∈ chu_objects w ⇒ 371 | (s ∈ obs c ⇔ s ⊆ w ∧ 372 | ∃c1 c2. c1 ∈ chu_objects w ∧ 373 | c2 ∈ chu_objects w ∧ 374 | image c1 ⊆ s ∧ image c2 ⊆ w DIFF s ∧ 375 | c ≃ c1 && c2 -: w) 376 | Proof 377 | strip_tac 378 | \\ EQ_TAC 379 | >- ( 380 | strip_tac 381 | \\ qabbrev_tac`c1 = mk_cf (c with env := env_for c s)` 382 | \\ qabbrev_tac`c2 = mk_cf (c with env := env_for c (w DIFF s))` 383 | \\ `c1 ∈ chu_objects w ∧ c2 ∈ chu_objects w` 384 | by ( 385 | fs[chu_objects_def, Abbr`c1`, Abbr`c2`] 386 | \\ fs[wf_def, finite_cf_def] 387 | \\ simp[env_for_def, image_def, SUBSET_DEF, PULL_EXISTS]) 388 | \\ `FINITE w` by metis_tac[in_chu_objects_finite_world] 389 | \\ conj_asm1_tac 390 | >- ( fs[obs_def, chu_objects_def] \\ rfs[] ) 391 | \\ map_every qexists_tac[`c1`,`c2`] \\ simp[] 392 | \\ conj_asm1_tac 393 | >- (simp[image_def, Abbr`c1`, SUBSET_DEF, PULL_EXISTS, mk_cf_def, env_for_def]) 394 | \\ conj_asm1_tac 395 | >- (simp[image_def, Abbr`c2`, SUBSET_DEF, PULL_EXISTS, mk_cf_def, env_for_def] 396 | \\ fs[chu_objects_def, wf_def]) 397 | \\ Cases_on`c.agent = ∅` 398 | >- ( 399 | `c1 = c2 ∧ c2 = c` 400 | by ( 401 | simp[Abbr`c1`,Abbr`c2`,mk_cf_def, env_for_def] 402 | \\ fs[chu_objects_def, wf_def] 403 | \\ simp[cf_component_equality, FUN_EQ_THM]) 404 | \\ simp[] 405 | \\ Cases_on`c.env = ∅` 406 | >- ( 407 | `c = null w` by ( 408 | simp[null_def, cf_component_equality] 409 | \\ fs[chu_objects_def, wf_def] 410 | \\ simp[FUN_EQ_THM] ) 411 | \\ simp[] ) 412 | \\ `c ≃ cf0 w -: w` by metis_tac[empty_agent_nonempty_env] 413 | \\ `c ≃ cf0 w && cf0 w -: w` by metis_tac[cf0_prod_cf0, homotopy_equiv_trans, homotopy_equiv_sym] 414 | \\ `c && c ≃ cf0 w && cf0 w -: w` by metis_tac[homotopy_equiv_prod, cf0_in_chu_objects] 415 | \\ metis_tac[homotopy_equiv_trans, homotopy_equiv_sym] ) 416 | \\ simp[homotopy_equiv_def] 417 | \\ qexists_tac`mk_chu_morphism c (c1 && c2) 418 | <| map_agent := W (CURRY encode_pair); 419 | map_env := λe. sum_CASE (decode_sum e) I I |>` 420 | \\ qexists_tac`mk_chu_morphism (c1 && c2) c 421 | <| map_agent := λp. @a. a ∈ UNCURRY (ifs c s) (decode_pair p); 422 | map_env := λe. encode_sum ((if e ∈ c1.env then INL else INR) e) |>` 423 | \\ conj_asm1_tac 424 | >- ( 425 | simp[maps_to_in_chu] 426 | \\ simp[is_chu_morphism_def, mk_chu_morphism_def] 427 | \\ simp[restrict_def] 428 | \\ simp[prod_def, PULL_EXISTS, mk_cf_def] 429 | \\ simp[Abbr`c1`, Abbr`c2`, mk_cf_def, PULL_EXISTS, env_for_def] 430 | \\ rw[] \\ rw[] 431 | \\ rw[sum_eval_def] ) 432 | \\ `(c1 && c2).env = IMAGE (encode_sum o (λe. (if e ∈ env_for c s then INL else INR) e)) c.env` 433 | by ( 434 | simp[Abbr`c1`, Abbr`c2`, prod_def, mk_cf_def, IMAGE_COMPOSE] 435 | \\ rewrite_tac[GSYM IMAGE_UNION] 436 | \\ AP_TERM_TAC 437 | \\ imp_res_tac env_for_compl_disjoint 438 | \\ pop_assum(qspec_then`s`mp_tac) 439 | \\ simp[IN_DISJOINT] 440 | \\ simp[EXTENSION, PULL_EXISTS] 441 | \\ `∀s e. e ∈ env_for c s ⇒ e ∈ c.env` by simp[env_for_def] 442 | \\ `wf c ∧ c.world = w` by fs[chu_objects_def] 443 | \\ metis_tac[obs_env_for] ) 444 | \\ conj_asm1_tac 445 | >- ( 446 | simp[maps_to_in_chu] 447 | \\ simp[is_chu_morphism_def, mk_chu_morphism_def] 448 | \\ simp[restrict_def] 449 | \\ simp[GSYM FORALL_AND_THM] 450 | \\ simp[PULL_FORALL] 451 | \\ rpt gen_tac 452 | \\ conj_tac >- (simp[Abbr`c1`] \\ metis_tac[]) 453 | \\ Cases_on`a ∈ (c1 && c2).agent` \\ simp[] 454 | \\ SELECT_ELIM_TAC 455 | \\ pop_assum mp_tac 456 | \\ simp[Once prod_def, EXISTS_PROD] 457 | \\ strip_tac \\ simp[] 458 | \\ conj_tac >- fs[obs_def, Abbr`c1`, Abbr`c2`] 459 | \\ simp[prod_def, mk_cf_def, Abbr`c1`, Abbr`c2`] 460 | \\ rw[] \\ rfs[] \\ fs[] \\ rw[] 461 | \\ fs[ifs_def] 462 | \\ rw[sum_eval_def] 463 | \\ TRY(fs[env_for_def] \\ NO_TAC) 464 | \\ imp_res_tac env_for_compl_disjoint 465 | \\ pop_assum(qspec_then`s`mp_tac) 466 | \\ simp[IN_DISJOINT] 467 | \\ fs[chu_objects_def] 468 | \\ metis_tac[obs_env_for]) 469 | \\ qmatch_abbrev_tac`homotopic w (f o g -: _) _ ∧ homotopic w (g o f -: _) _` 470 | \\ imp_res_tac maps_to_comp \\ fs[] 471 | \\ imp_res_tac (#1(EQ_IMP_RULE maps_to_in_chu)) 472 | \\ simp[homotopic_def, pre_chu_def] 473 | \\ simp[hom_comb_def, chu_id_morphism_map_def] 474 | \\ qpat_x_assum`is_chu_morphism _ _ (_ o _ -: _).map`mp_tac 475 | \\ qpat_x_assum`is_chu_morphism _ _ (_ o _ -: _).map`mp_tac 476 | \\ DEP_REWRITE_TAC[compose_in_thm] 477 | \\ DEP_REWRITE_TAC[compose_thm] 478 | \\ simp[composable_in_def, pre_chu_def] 479 | \\ simp[is_chu_morphism_def] 480 | \\ simp[restrict_def] 481 | \\ ntac 2 strip_tac 482 | \\ conj_tac 483 | >- ( 484 | simp[Abbr`f`,Abbr`g`,mk_chu_morphism_def,restrict_def] 485 | \\ simp[prod_def] 486 | \\ rpt gen_tac 487 | \\ strip_tac 488 | \\ SELECT_ELIM_TAC 489 | \\ simp[ifs_def] 490 | \\ conj_tac >- metis_tac[] 491 | \\ simp[Abbr`c1`, Abbr`c2`] 492 | \\ metis_tac[] ) 493 | \\ rpt gen_tac 494 | \\ strip_tac 495 | \\ simp[Abbr`g`, Abbr`f`, mk_chu_morphism_def, restrict_def] 496 | \\ SELECT_ELIM_TAC 497 | \\ conj_tac 498 | >- ( 499 | qpat_x_assum`a ∈ _`mp_tac 500 | \\ simp[prod_def, EXISTS_PROD] 501 | \\ strip_tac 502 | \\ simp[] 503 | \\ qpat_x_assum`_ ∈ obs _`mp_tac 504 | \\ simp[obs_def] 505 | \\ fs[Abbr`c1`, Abbr`c2`] ) 506 | \\ gen_tac 507 | \\ qpat_x_assum`a ∈ _`mp_tac 508 | \\ simp[Once prod_def, EXISTS_PROD] 509 | \\ strip_tac \\ simp[] 510 | \\ simp[ifs_def] 511 | \\ strip_tac 512 | \\ simp[prod_def, mk_cf_def, Abbr`c1`, Abbr`c2`, PULL_EXISTS, EXISTS_PROD] 513 | \\ rw[] \\ rw[sum_eval_def] \\ qpat_x_assum`(COND _ _ _) _ = _`mp_tac \\ rw[] 514 | \\ TRY(fs[env_for_def] \\ NO_TAC) 515 | \\ fs[chu_objects_def] 516 | \\ metis_tac[obs_env_for] ) 517 | \\ strip_tac 518 | \\ `s ∈ obs (c1 && c2)` by metis_tac[image_compl_obs_prod] 519 | \\ metis_tac[obs_homotopy_equiv] 520 | QED 521 | 522 | Theorem prod_ensure_prevent_equiv_cfT: 523 | c ∈ chu_objects w ∧ c1 ∈ chu_objects w ∧ c2 ∈ chu_objects w ∧ s ⊆ w ∧ 524 | c ≃ c1 && c2 -: w ∧ image c1 ⊆ s ∧ image c2 ⊆ w DIFF s ⇒ 525 | (s ∈ prevent c ⇒ c1 ≃ cfT w -: w) ∧ 526 | (s ∈ ensure c ⇒ c2 ≃ cfT w -: w) 527 | Proof 528 | qho_match_abbrev_tac `P c c1 c2 s ⇒ Q c c1 c2 s ∧ R c c1 c2 s` 529 | \\ `∀c c1 c2 s. P c c1 c2 s ⇒ R c c1 c2 s` suffices_by ( 530 | simp[Abbr`P`, Abbr`R`, Abbr`Q`] 531 | \\ reverse(rw[]) \\ first_x_assum irule \\ simp[] 532 | >- metis_tac[] 533 | \\ qexists_tac`c` 534 | \\ qexists_tac`c2` 535 | \\ qexists_tac`w DIFF s` 536 | \\ simp[GSYM prevent_ensure_compl] 537 | \\ simp[DIFF_DIFF_SUBSET] 538 | \\ metis_tac[homotopy_equiv_trans, prod_comm, iso_homotopy_equiv] ) 539 | \\ rw[Abbr`P`, Abbr`R`, Abbr`Q`] 540 | \\ rfs[ensure_cf1_morphism] 541 | \\ `c.world = w` by fs[chu_objects_def] 542 | \\ `FINITE w` by metis_tac[in_chu_objects_finite_world] 543 | \\ first_assum(mp_then Any (qspec_then`w`mp_tac) is_chu_morphism_maps_to) 544 | \\ simp[] \\ strip_tac 545 | \\ `∃f. f :- c → c1 && c2 -: chu w` by metis_tac[homotopy_equiv_def] 546 | \\ last_assum(mp_then Any mp_tac maps_to_comp) 547 | \\ simp[] 548 | \\ disch_then(first_assum o mp_then Any strip_assume_tac) 549 | \\ first_assum(mp_then Any (qspecl_then[`proj2 c1 c2`,`c2`]mp_tac) maps_to_comp) 550 | \\ simp[] \\ strip_tac 551 | \\ first_assum(mp_then Any mp_tac (#1(EQ_IMP_RULE(maps_to_in_chu)))) 552 | \\ qmatch_goalsub_abbrev_tac`is_chu_morphism _ _ g.map` 553 | \\ simp[is_chu_morphism_def] \\ strip_tac 554 | \\ reverse(Cases_on`c2.env = ∅`) 555 | >- ( 556 | fs[GSYM MEMBER_NOT_EMPTY] 557 | \\ `c2.eval (g.map.map_agent "") x ∈ w DIFF s` 558 | by ( fs[image_def, SUBSET_DEF] \\ metis_tac[] ) 559 | \\ `(cf1 w s).eval "" (g.map.map_env x) ∈ s` 560 | by ( rewrite_tac[cf1_def] \\ simp[mk_cf_def] ) 561 | \\ metis_tac[IN_DIFF] ) 562 | \\ `c2.agent ≠ ∅` by metis_tac[MEMBER_NOT_EMPTY] 563 | \\ metis_tac[empty_env_nonempty_agent] 564 | QED 565 | 566 | Theorem cfT_ctrl_obs_disjoint: 567 | c ∈ chu_objects w ∧ ¬(c ≃ cfT w -: w) ⇒ DISJOINT (ctrl c) (obs c) 568 | Proof 569 | CCONTR_TAC \\ fs[IN_DISJOINT] 570 | \\ `FINITE w` by metis_tac[in_chu_objects_finite_world] 571 | \\ fs[UNDISCH(obs_homotopy_equiv_prod)] 572 | \\ fs[ctrl_def] 573 | \\ `c1 ≃ cfT w -: w ∧ c2 ≃ cfT w -: w` by metis_tac[prod_ensure_prevent_equiv_cfT] 574 | \\ PROVE_TAC[homotopy_equiv_prod, homotopy_equiv_trans, 575 | iso_homotopy_equiv, prod_cfT, cfT_in_chu_objects] 576 | QED 577 | 578 | Theorem image_subset_ensure_inter_obs_alt: 579 | c ∈ chu_objects w ∧ s ∈ ensure c ∩ obs c ⇒ image c ⊆ s 580 | Proof 581 | rw[] 582 | \\ `FINITE w` by metis_tac[in_chu_objects_finite_world] 583 | \\ fs[UNDISCH(obs_homotopy_equiv_prod)] 584 | \\ `c2 ≃ cfT w -: w` by metis_tac[prod_ensure_prevent_equiv_cfT] 585 | \\ `c ≃ c1 -: w` by metis_tac[homotopy_equiv_trans, prod_cfT, 586 | homotopy_equiv_prod, iso_homotopy_equiv, 587 | cfT_in_chu_objects, homotopy_equiv_refl] 588 | \\ metis_tac[homotopy_equiv_image] 589 | QED 590 | 591 | val _ = export_theory(); 592 | -------------------------------------------------------------------------------- /cf5Script.sml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright 2021 DeepMind Technologies Limited. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | https://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | *) 16 | 17 | open HolKernel boolLib bossLib Parse dep_rewrite 18 | combinTheory pairTheory listTheory pred_setTheory helperSetTheory categoryTheory 19 | cf0Theory cf1Theory cf2Theory cf3Theory cf4Theory 20 | 21 | val _ = new_theory"cf5"; 22 | 23 | Definition subagent_def: 24 | subagent w c d ⇔ c ∈ chu_objects w ∧ d ∈ chu_objects w ∧ 25 | ∀m. m :- c → cfbot w w -: chu w ⇒ 26 | ∃m1 m2. m1 :- c → d -: chu w ∧ m2 :- d → cfbot w w -: chu w ∧ m = m2 o m1 -: chu w 27 | End 28 | 29 | 30 | Overload "subagent_syntax" = ``λc d w. subagent w c d`` 31 | 32 | val _ = add_rule { 33 | term_name = "subagent_syntax", 34 | fixity = Infix(NONASSOC,450), 35 | pp_elements = [HardSpace 1, TOK "\226\151\129", HardSpace 1, TM, HardSpace 1, TOK "-:"], 36 | paren_style = OnlyIfNecessary, 37 | block_style = (AroundEachPhrase, (PP.INCONSISTENT, 0)) 38 | }; 39 | 40 | Theorem morphisms_to_cfbot: 41 | c ∈ chu_objects w ⇒ 42 | BIJ (λm. m.map.map_env "") {m | m :- c → cfbot w w -: chu w} c.env 43 | Proof 44 | rw[BIJ_IFF_INV] 45 | >- ( 46 | fs[maps_to_in_chu, is_chu_morphism_def] 47 | \\ first_x_assum irule 48 | \\ rw[cfbot_def] ) 49 | \\ `FINITE w` by metis_tac[in_chu_objects_finite_world] 50 | \\ qexists_tac`λe. mk_chu_morphism c (cfbot w w) 51 | <| map_agent := flip c.eval e; map_env := K e |>` 52 | \\ simp[] 53 | \\ conj_asm1_tac 54 | >- ( 55 | rw[maps_to_in_chu] 56 | \\ rw[is_chu_morphism_def, mk_chu_morphism_def] 57 | \\ rw[restrict_def] 58 | \\ fs[chu_objects_def, wf_def] 59 | \\ fs[cfbot_def, cf1_def, mk_cf_def] ) 60 | \\ conj_tac 61 | >- ( 62 | rw[maps_to_in_chu] 63 | \\ rw[morphism_component_equality] 64 | \\ simp[chu_morphism_map_component_equality] 65 | \\ simp[mk_chu_morphism_def] 66 | \\ simp[restrict_def, FUN_EQ_THM] 67 | \\ fs[is_chu_morphism_def] 68 | \\ fs[cfbot_def, cf1_def, mk_cf_def] 69 | \\ fs[extensional_def] 70 | \\ metis_tac[] ) 71 | \\ rw[mk_chu_morphism_def] 72 | \\ rw[restrict_def] 73 | \\ fs[cfbot_def, cf1_def, mk_cf_def] 74 | QED 75 | 76 | Definition covering_subagent_def: 77 | covering_subagent w c d ⇔ 78 | c ∈ chu_objects w ∧ d ∈ chu_objects w ∧ 79 | ∀e. e ∈ c.env ⇒ 80 | ∃f m. f ∈ d.env ∧ m :- c → d -: chu w ∧ e = m.map.map_env f 81 | End 82 | 83 | Theorem subagent_covering: 84 | c ◁ d -: w ⇔ covering_subagent w c d 85 | Proof 86 | rw[subagent_def, covering_subagent_def] 87 | \\ Cases_on`c ∈ chu_objects w` \\ simp[] 88 | \\ Cases_on`d ∈ chu_objects w` \\ simp[] 89 | \\ imp_res_tac morphisms_to_cfbot 90 | \\ `∀P. (∀e. e ∈ c.env ⇒ P e) ⇔ (∀m. m :- c → cfbot w w -: chu w ⇒ P (m.map.map_env ""))` 91 | by ( fs[BIJ_IFF_INV] \\ metis_tac[] ) 92 | \\ simp[] 93 | \\ ho_match_mp_tac ConseqConvTheory.forall_eq_thm 94 | \\ gen_tac 95 | \\ Cases_on`m :- c → cfbot w w -: chu w` \\ simp[] 96 | \\ `∀P. (∃e (x:chu_morphism). e ∈ d.env ∧ P e x) ⇔ 97 | (∃m x. m :- d → cfbot w w -: chu w ∧ P (m.map.map_env "") x)` 98 | by ( fs[BIJ_IFF_INV] \\ metis_tac[] ) 99 | \\ simp[CONJ_ASSOC] 100 | \\ CONV_TAC(PATH_CONV"lrbblr"(REWR_CONV CONJ_COMM)) 101 | \\ CONV_TAC(LAND_CONV(SWAP_EXISTS_CONV)) 102 | \\ ho_match_mp_tac ConseqConvTheory.exists_eq_thm 103 | \\ qx_gen_tac`n` 104 | \\ ho_match_mp_tac ConseqConvTheory.exists_eq_thm 105 | \\ qx_gen_tac`p` 106 | \\ Cases_on`n :- d → cfbot w w -: chu w` \\ simp[] 107 | \\ Cases_on`p :- c → d -: chu w` \\ simp[] 108 | \\ DEP_REWRITE_TAC[compose_in_thm] 109 | \\ DEP_REWRITE_TAC[compose_thm] 110 | \\ DEP_REWRITE_TAC[chu_comp] 111 | \\ fs[maps_to_in_chu, composable_in_def, pre_chu_def] 112 | \\ simp[morphism_component_equality] 113 | \\ simp[chu_morphism_map_component_equality] 114 | \\ simp[FUN_EQ_THM] 115 | \\ simp[cfbot_def] 116 | \\ simp[restrict_def] 117 | \\ first_x_assum(qspec_then`P`kall_tac) 118 | \\ first_x_assum(qspec_then`P`kall_tac) 119 | \\ qhdtm_x_assum`BIJ`kall_tac 120 | \\ qhdtm_x_assum`BIJ`kall_tac 121 | \\ rw[] 122 | \\ fs[cfbot_def, is_chu_morphism_def, extensional_def] 123 | \\ fs[cf1_def, mk_cf_def] 124 | \\ metis_tac[] 125 | QED 126 | 127 | Definition currying_subagent_def: 128 | currying_subagent w c d ⇔ 129 | c ∈ chu_objects w ∧ d ∈ chu_objects w ∧ 130 | ∃z. z ∈ chu_objects d.agent ∧ c ≃ move d z -: w 131 | End 132 | 133 | Theorem hom_finite[simp]: 134 | finite_cf c ∧ finite_cf d ⇒ 135 | FINITE (chu w | c → d |) 136 | Proof 137 | rw[hom_def, maps_to_in_chu, finite_cf_def] 138 | \\ qspec_then`λm. (m.map.map_agent, m.map.map_env)`irule FINITE_INJ 139 | \\ qexists_tac`{f | extensional f c.agent ∧ IMAGE f c.agent ⊆ d.agent} × 140 | {f | extensional f d.env ∧ IMAGE f d.env ⊆ c.env}` 141 | \\ reverse conj_tac 142 | >- ( 143 | simp[INJ_DEF] 144 | \\ conj_tac 145 | >- ( simp[is_chu_morphism_def] \\ simp[PULL_EXISTS, SUBSET_DEF] ) 146 | \\ simp[chu_morphism_map_component_equality, morphism_component_equality] ) 147 | \\ irule FINITE_CROSS 148 | \\ conj_tac 149 | THENL [qspec_then`λf. IMAGE (λx. (x, f x)) c.agent`irule FINITE_INJ 150 | \\ qexists_tac`c` \\ qexists_tac`POW (c.agent × d.agent)`, 151 | qspec_then`λf. IMAGE (λx. (x, f x)) d.env`irule FINITE_INJ 152 | \\ qexists_tac`d` \\ qexists_tac`POW (d.env × c.env)`] 153 | \\ simp[] 154 | \\ simp[INJ_DEF, IN_POW] 155 | \\ simp[SUBSET_DEF, PULL_EXISTS] 156 | \\ simp[EXTENSION, PULL_EXISTS, FORALL_PROD] 157 | \\ simp[FUN_EQ_THM, extensional_def] 158 | \\ metis_tac[] 159 | QED 160 | 161 | Definition encode_morphism_def: 162 | encode_morphism m = 163 | encode_pair (encode_function m.dom.agent m.map.map_agent, 164 | encode_function m.cod.env m.map.map_env) 165 | End 166 | 167 | Definition decode_morphism_def: 168 | decode_morphism c d s = 169 | <| dom := c; cod := d; map := <| map_agent := decode_function (FST (decode_pair s)); 170 | map_env := decode_function (SND (decode_pair s)) |> |> 171 | End 172 | 173 | Theorem decode_encode_morphism[simp]: 174 | m.dom = c ∧ m.cod = d ∧ FINITE c.agent ∧ FINITE d.env ∧ 175 | extensional m.map.map_agent c.agent ∧ 176 | extensional m.map.map_env d.env 177 | ⇒ 178 | decode_morphism c d (encode_morphism m) = m 179 | Proof 180 | rw[morphism_component_equality, decode_morphism_def] 181 | \\ rw[chu_morphism_map_component_equality] 182 | \\ rw[encode_morphism_def] 183 | QED 184 | 185 | Theorem decode_encode_chu_morphism[simp]: 186 | m :- c → d -: chu w ⇒ 187 | decode_morphism c d (encode_morphism m) = m 188 | Proof 189 | rw[maps_to_in_chu, is_chu_morphism_def] 190 | \\ irule decode_encode_morphism 191 | \\ fs[chu_objects_def, wf_def] 192 | \\ fs[finite_cf_def] 193 | QED 194 | 195 | (* 196 | Definition encode_hom_def: 197 | encode_hom w c d = encode_list (MAP encode_morphism (SET_TO_LIST (chu w | c → d |))) 198 | End 199 | 200 | Definition decode_hom_def: 201 | decode_hom c d s = set (MAP (decode_morphism c d) (decode_list s)) 202 | End 203 | 204 | Theorem decode_encode_hom[simp]: 205 | finite_cf c ∧ finite_cf d ⇒ 206 | decode_hom c d (encode_hom w c d) = chu w | c → d | 207 | Proof 208 | rw[decode_hom_def, EXTENSION, MEM_MAP, encode_hom_def, PULL_EXISTS] 209 | \\ rw[EQ_IMP_THM] 210 | \\ TRY(qexists_tac`x` \\ simp[]) 211 | \\ DEP_REWRITE_TAC[decode_encode_morphism] 212 | \\ fs[hom_def, maps_to_in_chu, finite_cf_def] 213 | \\ fs[is_chu_morphism_def] 214 | QED 215 | *) 216 | 217 | Theorem covering_implies_currying: 218 | covering_subagent w c d ⇒ currying_subagent w c d 219 | Proof 220 | rw[covering_subagent_def, currying_subagent_def] 221 | \\ `FINITE w` by metis_tac[in_chu_objects_finite_world] 222 | \\ `finite_cf c ∧ finite_cf d` by fs[chu_objects_def, wf_def] 223 | \\ qexists_tac`mk_cf <| world := d.agent; agent := c.agent; 224 | env := IMAGE encode_morphism (chu w |c → d|); 225 | eval := λa m. (decode_morphism c d m).map.map_agent a |>` 226 | \\ conj_asm1_tac 227 | >- ( 228 | simp[chu_objects_def] 229 | \\ conj_tac 230 | >- ( 231 | simp[SUBSET_DEF, image_def, PULL_EXISTS] 232 | \\ rw[hom_def] 233 | \\ fs[maps_to_in_chu, finite_cf_def, is_chu_morphism_def] ) 234 | \\ simp[finite_cf_def] 235 | \\ fs[chu_objects_def] 236 | \\ metis_tac[hom_finite, wf_def, finite_cf_def, IMAGE_FINITE]) 237 | \\ qmatch_assum_abbrev_tac`z ∈ chu_objects d.agent` 238 | \\ simp[homotopy_equiv_def] 239 | \\ qexists_tac`mk_chu_morphism c (move d z) 240 | <| map_agent := I; 241 | map_env := λx. (decode_morphism c d (FST (decode_pair x))).map.map_env 242 | (SND (decode_pair x)) |>` 243 | \\ qmatch_goalsub_abbrev_tac`f :- c → move d z -: _` 244 | \\ qexists_tac`mk_chu_morphism (move d z) c 245 | <| map_agent := I; 246 | map_env := λe. 247 | let p = @p. (FST p).map.map_env (SND p) = e ∧ (FST p) :- c → d -: chu w ∧ 248 | (SND p) ∈ d.env 249 | in encode_pair (encode_morphism (FST p), SND p) |>` 250 | \\ qmatch_goalsub_abbrev_tac`g :- move d z → _ -: _` 251 | \\ conj_asm1_tac 252 | >- ( 253 | simp[maps_to_in_chu, Abbr`f`] 254 | \\ simp[mk_chu_morphism_def] 255 | \\ simp[is_chu_morphism_def, PULL_EXISTS, FORALL_PROD] 256 | \\ simp[restrict_def] 257 | \\ simp[Abbr`z`, PULL_EXISTS] 258 | \\ CONV_TAC(LAND_CONV(RESORT_FORALL_CONV(sort_vars["x"]))) 259 | \\ CONV_TAC(RAND_CONV(RESORT_FORALL_CONV(sort_vars["x"]))) 260 | \\ simp[GSYM FORALL_AND_THM] 261 | \\ gen_tac 262 | \\ Cases_on`x ∈ chu w |c → d|` \\ simp[] 263 | \\ simp[mk_cf_def] 264 | \\ gen_tac 265 | \\ reverse IF_CASES_TAC >- metis_tac[] 266 | \\ pop_assum kall_tac 267 | \\ DEP_REWRITE_TAC[decode_encode_morphism] 268 | \\ fs[hom_def, maps_to_in_chu, is_chu_morphism_def, finite_cf_def] ) 269 | \\ conj_asm1_tac 270 | >- ( 271 | simp[Once maps_to_in_chu, Abbr`g`] 272 | \\ simp[mk_chu_morphism_def] 273 | \\ simp[is_chu_morphism_def] 274 | \\ simp[restrict_def] 275 | \\ qmatch_goalsub_abbrev_tac`a ∧ b ∧ x` 276 | \\ `b` by simp[Abbr`b`, Abbr`z`] 277 | \\ qunabbrev_tac`b` 278 | \\ simp[] 279 | \\ simp[Abbr`a`, Abbr`x`] 280 | \\ CONV_TAC(RAND_CONV(SWAP_FORALL_CONV)) 281 | \\ simp[GSYM FORALL_AND_THM] 282 | \\ qx_gen_tac`e` 283 | \\ Cases_on`e ∈ c.env` \\ simp[] 284 | \\ SELECT_ELIM_TAC 285 | \\ conj_tac >- ( simp[EXISTS_PROD] \\ metis_tac[] ) 286 | \\ simp[FORALL_PROD] 287 | \\ qx_gen_tac`g` 288 | \\ qx_gen_tac`x` 289 | \\ strip_tac 290 | \\ simp[Abbr`z`] 291 | \\ conj_asm1_tac >- (simp[hom_def] \\ metis_tac[]) 292 | \\ simp[mk_cf_def, move_def] 293 | \\ gen_tac \\ strip_tac 294 | \\ DEP_REWRITE_TAC[decode_encode_morphism] 295 | \\ fs[maps_to_in_chu, is_chu_morphism_def, finite_cf_def] 296 | \\ rpt BasicProvers.VAR_EQ_TAC 297 | \\ simp[] ) 298 | \\ imp_res_tac maps_to_comp \\ fs[] 299 | \\ conj_tac \\ irule homotopic_id 300 | \\ fs[maps_to_in_chu, pre_chu_def] 301 | \\ DEP_REWRITE_TAC[compose_in_thm] 302 | \\ DEP_REWRITE_TAC[compose_thm] 303 | \\ DEP_REWRITE_TAC[chu_comp] 304 | \\ fs[composable_in_def, pre_chu_def] 305 | \\ simp[Abbr`f`, Abbr`g`, mk_chu_morphism_def] 306 | \\ simp[restrict_def, FUN_EQ_THM, Abbr`z`] 307 | QED 308 | 309 | Theorem subagent_same_homotopy_equiv: 310 | c1 ◁ d -: w ∧ c1 ≃ c2 -: w ⇒ c2 ◁ d -: w 311 | Proof 312 | rw[subagent_covering] 313 | \\ fs[covering_subagent_def] 314 | \\ fs[homotopy_equiv_def] 315 | \\ conj_asm1_tac >- fs[maps_to_in_chu] 316 | \\ gen_tac \\ strip_tac 317 | \\ first_assum(qspec_then`f.map.map_env e`mp_tac) 318 | \\ impl_tac >- ( fs[maps_to_in_chu, is_chu_morphism_def] ) 319 | \\ disch_then(qx_choosel_then[`x`,`m`]strip_assume_tac) 320 | \\ qexists_tac`x` \\ simp[] 321 | \\ qexists_tac`mk_chu_morphism c2 d 322 | <| map_agent := m.map.map_agent o g.map.map_agent; 323 | map_env := (x =+ e)(g.map.map_env o m.map.map_env) |>` 324 | \\ conj_asm1_tac 325 | >- ( 326 | simp[maps_to_in_chu] 327 | \\ imp_res_tac maps_to_comp \\ fs[] 328 | \\ qpat_assum`m o g -: _ :- _ → _ -: _`mp_tac 329 | \\ qpat_assum`homotopic w (f o g -: _) _`mp_tac 330 | \\ DEP_REWRITE_TAC[compose_in_thm] 331 | \\ DEP_REWRITE_TAC[compose_thm] 332 | \\ DEP_REWRITE_TAC[chu_comp] 333 | \\ simp[CONJ_ASSOC] 334 | \\ conj_tac >- fs[maps_to_in_chu, composable_in_def, pre_chu_def] 335 | \\ simp[maps_to_in_chu, pre_chu_def, homotopic_def, hom_comb_def] 336 | \\ simp[is_chu_morphism_def, mk_chu_morphism_def, chu_id_morphism_map_def] 337 | \\ simp[restrict_def, APPLY_UPDATE_THM] 338 | \\ rw[] \\ fs[] \\ rw[] \\ fs[] 339 | \\ metis_tac[] ) 340 | \\ simp[mk_chu_morphism_def] 341 | \\ simp[restrict_def, APPLY_UPDATE_THM] 342 | QED 343 | 344 | Theorem currying_implies_covering_eq_case: 345 | d ∈ chu_objects w ∧ 346 | z ∈ chu_objects d.agent ∧ 347 | e ∈ (move d z).env ⇒ 348 | ∃f m. f ∈ d.env ∧ m :- move d z → d -: chu w ∧ e = m.map.map_env f 349 | Proof 350 | simp[EXISTS_PROD, PULL_EXISTS] 351 | \\ qx_genl_tac[`x`,`f`] \\ rw[] 352 | \\ qexists_tac`f` 353 | \\ qexists_tac`mk_chu_morphism (move d z) d 354 | <| map_agent := flip z.eval x; 355 | map_env := λf. encode_pair (x, f) |>` 356 | \\ simp[] 357 | \\ conj_asm1_tac 358 | >- ( 359 | simp[maps_to_in_chu] 360 | \\ simp[mk_chu_morphism_def] 361 | \\ simp[is_chu_morphism_def, PULL_EXISTS, EXISTS_PROD] 362 | \\ simp[restrict_def] 363 | \\ fs[chu_objects_def, wf_def] \\ fs[] ) 364 | \\ simp[mk_chu_morphism_def] 365 | \\ simp[restrict_def] 366 | QED 367 | 368 | Theorem currying_implies_covering: 369 | currying_subagent w c d ⇒ covering_subagent w c d 370 | Proof 371 | rw[currying_subagent_def, covering_subagent_def] 372 | \\ Cases_on`c = move d z` 373 | >- metis_tac[currying_implies_covering_eq_case] 374 | \\ imp_res_tac homotopy_equiv_sym 375 | \\ first_assum(mp_then Any mp_tac subagent_same_homotopy_equiv) 376 | \\ simp[subagent_covering] 377 | \\ simp[covering_subagent_def, PULL_EXISTS, EXISTS_PROD] 378 | \\ disch_then irule 379 | \\ rw[] 380 | \\ PROVE_TAC[SIMP_RULE(srw_ss())[EXISTS_PROD]currying_implies_covering_eq_case] 381 | QED 382 | 383 | Theorem subagent_currying: 384 | (c ◁ d -: w ⇔ currying_subagent w c d) 385 | Proof 386 | metis_tac[subagent_covering, currying_implies_covering, covering_implies_currying] 387 | QED 388 | 389 | Theorem homotopy_equiv_move_swap_cf1: 390 | c ∈ chu_objects w ⇒ 391 | c ≃ move c (swap (cf1 c.agent c.agent)) -: w 392 | Proof 393 | rw[homotopy_equiv_def] 394 | \\ `FINITE c.agent` by (fs[chu_objects_def] \\ metis_tac[wf_def, finite_cf_def]) 395 | \\ qexists_tac`mk_chu_morphism c (move c (swap (cf1 c.agent c.agent))) 396 | <| map_agent := I; map_env := SND o decode_pair |>` 397 | \\ qexists_tac`mk_chu_morphism(move c (swap (cf1 c.agent c.agent))) c 398 | <| map_agent := I; map_env := λe. encode_pair("", e) |>` 399 | \\ conj_asm1_tac 400 | >- ( 401 | simp[mk_chu_morphism_def, maps_to_in_chu] 402 | \\ simp[is_chu_morphism_def, PULL_EXISTS, EXISTS_PROD] 403 | \\ rw[move_def, restrict_def] 404 | \\ rw[cf1_def, mk_cf_def] ) 405 | \\ conj_asm1_tac 406 | >- ( 407 | simp[mk_chu_morphism_def, maps_to_in_chu] 408 | \\ simp[is_chu_morphism_def, PULL_EXISTS, EXISTS_PROD] 409 | \\ rw[move_def, restrict_def] 410 | \\ rw[cf1_def, mk_cf_def] ) 411 | \\ qmatch_goalsub_abbrev_tac`f o g -: _` 412 | \\ imp_res_tac maps_to_comp \\ fs[] 413 | \\ conj_tac \\ irule homotopic_id 414 | \\ fs[maps_to_in_chu, pre_chu_def] 415 | \\ DEP_REWRITE_TAC[compose_in_thm] 416 | \\ DEP_REWRITE_TAC[compose_thm] 417 | \\ DEP_REWRITE_TAC[chu_comp] 418 | \\ fs[composable_in_def, pre_chu_def] 419 | \\ simp[Abbr`f`, Abbr`g`, mk_chu_morphism_def] 420 | \\ simp[restrict_def, FUN_EQ_THM] 421 | QED 422 | 423 | Theorem homotopy_equiv_subagent: 424 | c1 ≃ c2 -: w ⇒ c1 ◁ c2 -: w 425 | Proof 426 | simp[subagent_currying, currying_subagent_def] 427 | \\ strip_tac 428 | \\ imp_res_tac homotopy_equiv_in_chu_objects \\ simp[] 429 | \\ qexists_tac`swap (cf1 c2.agent c2.agent)` 430 | \\ `FINITE c2.agent` by (fs[chu_objects_def] \\ metis_tac[wf_def, finite_cf_def]) 431 | \\ simp[] 432 | \\ irule homotopy_equiv_trans 433 | \\ goal_assum(first_assum o mp_then Any mp_tac) 434 | \\ simp[homotopy_equiv_move_swap_cf1] 435 | QED 436 | 437 | Theorem subagent_refl[simp]: 438 | c ∈ chu_objects w ⇒ c ◁ c -: w 439 | Proof 440 | metis_tac[homotopy_equiv_refl, homotopy_equiv_subagent] 441 | QED 442 | 443 | Theorem subagent_trans: 444 | c1 ◁ c2 -: w ∧ c2 ◁ c3 -: w ⇒ c1 ◁ c3 -: w 445 | Proof 446 | rw[subagent_def] 447 | \\ first_x_assum(first_x_assum o mp_then Any strip_assume_tac) 448 | \\ first_x_assum(first_x_assum o mp_then Any strip_assume_tac) 449 | \\ imp_res_tac maps_to_comp \\ fs[] 450 | \\ goal_assum(first_assum o mp_then Any mp_tac) 451 | \\ goal_assum(first_assum o mp_then Any mp_tac) 452 | \\ irule comp_assoc 453 | \\ fs[maps_to_in_chu, composable_in_def, pre_chu_def] 454 | QED 455 | 456 | Theorem subagent_homotopy_equiv: 457 | c1 ◁ d1 -: w ∧ c1 ≃ c2 -: w ∧ d1 ≃ d2 -: w ⇒ 458 | c2 ◁ d2 -: w 459 | Proof 460 | metis_tac[homotopy_equiv_subagent, homotopy_equiv_sym, subagent_trans] 461 | QED 462 | 463 | Definition mutual_subagents_def: 464 | mutual_subagents w c d ⇔ c ◁ d -: w ∧ d ◁ c -: w 465 | End 466 | 467 | Theorem mutual_subagents_refl[simp]: 468 | c ∈ chu_objects w ⇒ mutual_subagents w c c 469 | Proof 470 | metis_tac[mutual_subagents_def, subagent_refl] 471 | QED 472 | 473 | Theorem mutual_subagents_sym: 474 | mutual_subagents w c d ⇔ mutual_subagents w c d 475 | Proof 476 | rw[mutual_subagents_def] 477 | QED 478 | 479 | Theorem mutual_subagents_trans: 480 | mutual_subagents w c1 c2 ∧ mutual_subagents w c2 c3 ⇒ mutual_subagents w c1 c3 481 | Proof 482 | metis_tac[mutual_subagents_def, subagent_trans] 483 | QED 484 | 485 | Theorem homotopy_equiv_mutual_subagents: 486 | c ≃ d -: w ⇒ mutual_subagents w c d 487 | Proof 488 | rw[mutual_subagents_def] 489 | \\ metis_tac[homotopy_equiv_subagent, homotopy_equiv_sym] 490 | QED 491 | 492 | Theorem sum_cfT_cfT: 493 | FINITE w ⇒ 494 | sum (cfT w) (cfT w) ≃ cfT w -: w ∧ 495 | ¬(sum (cfT w) (cfT w) ≅ cfT w -: chu w) 496 | Proof 497 | strip_tac 498 | \\ conj_tac 499 | >- ( 500 | irule empty_env_nonempty_agent 501 | \\ simp[sum_def, cfT_def, cf0_def]) 502 | \\ simp[iso_objs_thm, chu_iso_bij] 503 | \\ CCONTR_TAC \\ fs[] 504 | \\ fs[maps_to_in_chu] 505 | \\ `CARD f.dom.agent = CARD f.cod.agent` 506 | by ( 507 | irule FINITE_BIJ_CARD 508 | \\ fs[chu_objects_def] 509 | \\ metis_tac[wf_def, finite_cf_def]) 510 | \\ pop_assum mp_tac 511 | \\ simp[sum_def, cfT_def, cf0_def] 512 | \\ simp[CARD_UNION_EQN, SING_INTER] 513 | QED 514 | 515 | Theorem mutual_subagents_cfT_null: 516 | FINITE w ⇒ mutual_subagents w (cfT w) (null w) 517 | Proof 518 | rw[mutual_subagents_def, subagent_covering, covering_subagent_def] 519 | \\ fs[cfT_def, null_def, cf0_def] 520 | QED 521 | 522 | Theorem cfT_not_homotopy_equiv_null: 523 | ¬(cfT w ≃ null w -: w) 524 | Proof 525 | rw[homotopy_equiv_def] 526 | \\ CCONTR_TAC \\ fs[] 527 | \\ fs[maps_to_in_chu, is_chu_morphism_def] 528 | \\ fs[null_def, cfT_def, cf0_def] 529 | QED 530 | 531 | Theorem cfT_subagent[simp]: 532 | c ∈ chu_objects w ⇒ cfT w ◁ c -: w 533 | Proof 534 | strip_tac 535 | \\ imp_res_tac in_chu_objects_finite_world 536 | \\ rw[subagent_def] 537 | \\ fs[cfT_def, cf0_def, maps_to_in_chu, is_chu_morphism_def, cfbot_def] 538 | QED 539 | 540 | Theorem subagent_cfbot[simp]: 541 | c ∈ chu_objects w ⇒ c ◁ cfbot w w -: w 542 | Proof 543 | strip_tac 544 | \\ imp_res_tac in_chu_objects_finite_world 545 | \\ rw[subagent_def] 546 | \\ qexists_tac`m` 547 | \\ qexists_tac`id (cfbot w w) -: chu w` 548 | \\ simp[] 549 | \\ irule(GSYM id_comp2) 550 | \\ fs[maps_to_in_chu, pre_chu_def] 551 | QED 552 | 553 | Theorem null_subagent[simp]: 554 | c ∈ chu_objects w ⇒ null w ◁ c -: w 555 | Proof 556 | metis_tac[cfT_subagent, mutual_subagents_cfT_null, mutual_subagents_def, 557 | subagent_trans, in_chu_objects_finite_world] 558 | QED 559 | 560 | Theorem subagent_cfbot_image: 561 | c ∈ chu_objects w ∧ s ⊆ w ⇒ 562 | (c ◁ cfbot w s -: w ⇔ image c ⊆ s) 563 | Proof 564 | strip_tac 565 | \\ imp_res_tac in_chu_objects_finite_world 566 | \\ EQ_TAC 567 | >- ( 568 | CCONTR_TAC \\ fs[SUBSET_DEF] 569 | \\ fs[image_def] 570 | \\ fs[subagent_covering, covering_subagent_def] 571 | \\ first_x_assum drule 572 | \\ rw[] 573 | \\ CCONTR_TAC \\ fs[] 574 | \\ fs[maps_to_in_chu] 575 | \\ fs[is_chu_morphism_def] 576 | \\ qmatch_asmsub_abbrev_tac`c.eval a e` 577 | \\ `c.eval a e = (cfbot w s).eval (m.map.map_agent a) f` by metis_tac[] 578 | \\ pop_assum mp_tac 579 | \\ simp_tac(srw_ss())[cfbot_def, cf1_def, mk_cf_def] 580 | \\ fs[cfbot_def, cf1_def, mk_cf_def] 581 | \\ metis_tac[]) 582 | \\ rw[subagent_covering, covering_subagent_def] 583 | \\ qexists_tac`""` 584 | \\ qexists_tac`mk_chu_morphism c (cfbot w s) <| map_agent := flip c.eval e; map_env := K e |>` 585 | \\ simp[maps_to_in_chu] 586 | \\ simp[is_chu_morphism_def, mk_chu_morphism_def] 587 | \\ simp[cfbot_def, restrict_def] 588 | \\ simp[cf1_def, mk_cf_def] 589 | \\ fs[SUBSET_DEF, image_def, PULL_EXISTS] 590 | QED 591 | 592 | Theorem obs_homotopy_equiv_prod_subagent: 593 | c ∈ chu_objects w ⇒ 594 | (s ∈ obs c ⇔ 595 | s ⊆ w ∧ ∃c1 c2. c1 ◁ cfbot w s -: w ∧ c2 ◁ cfbot w (w DIFF s) -: w ∧ 596 | c ≃ c1 && c2 -: w) 597 | Proof 598 | strip_tac 599 | \\ drule obs_homotopy_equiv_prod 600 | \\ simp[] 601 | \\ disch_then kall_tac 602 | \\ Cases_on`s ⊆ w` \\ simp[] 603 | \\ EQ_TAC \\ strip_tac 604 | \\ map_every qexists_tac[`c1`,`c2`] 605 | \\ simp[subagent_cfbot_image] 606 | \\ DEP_REWRITE_TAC[GSYM subagent_cfbot_image] 607 | \\ simp[] 608 | \\ fs[subagent_def] 609 | QED 610 | 611 | val _ = export_theory(); 612 | -------------------------------------------------------------------------------- /docs/code-of-conduct.md: -------------------------------------------------------------------------------- 1 | # Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | In the interest of fostering an open and welcoming environment, we as 6 | contributors and maintainers pledge to making participation in our project and 7 | our community a harassment-free experience for everyone, regardless of age, body 8 | size, disability, ethnicity, gender identity and expression, level of 9 | experience, education, socio-economic status, nationality, personal appearance, 10 | race, religion, or sexual identity and orientation. 11 | 12 | ## Our Standards 13 | 14 | Examples of behavior that contributes to creating a positive environment 15 | include: 16 | 17 | * Using welcoming and inclusive language 18 | * Being respectful of differing viewpoints and experiences 19 | * Gracefully accepting constructive criticism 20 | * Focusing on what is best for the community 21 | * Showing empathy towards other community members 22 | 23 | Examples of unacceptable behavior by participants include: 24 | 25 | * The use of sexualized language or imagery and unwelcome sexual attention or 26 | advances 27 | * Trolling, insulting/derogatory comments, and personal or political attacks 28 | * Public or private harassment 29 | * Publishing others' private information, such as a physical or electronic 30 | address, without explicit permission 31 | * Other conduct which could reasonably be considered inappropriate in a 32 | professional setting 33 | 34 | ## Our Responsibilities 35 | 36 | Project maintainers are responsible for clarifying the standards of acceptable 37 | behavior and are expected to take appropriate and fair corrective action in 38 | response to any instances of unacceptable behavior. 39 | 40 | Project maintainers have the right and responsibility to remove, edit, or reject 41 | comments, commits, code, wiki edits, issues, and other contributions that are 42 | not aligned to this Code of Conduct, or to ban temporarily or permanently any 43 | contributor for other behaviors that they deem inappropriate, threatening, 44 | offensive, or harmful. 45 | 46 | ## Scope 47 | 48 | This Code of Conduct applies both within project spaces and in public spaces 49 | when an individual is representing the project or its community. Examples of 50 | representing a project or community include using an official project e-mail 51 | address, posting via an official social media account, or acting as an appointed 52 | representative at an online or offline event. Representation of a project may be 53 | further defined and clarified by project maintainers. 54 | 55 | This Code of Conduct also applies outside the project spaces when the Project 56 | Steward has a reasonable belief that an individual's behavior may have a 57 | negative impact on the project or its community. 58 | 59 | ## Conflict Resolution 60 | 61 | We do not believe that all conflict is bad; healthy debate and disagreement 62 | often yield positive results. However, it is never okay to be disrespectful or 63 | to engage in behavior that violates the project’s code of conduct. 64 | 65 | If you see someone violating the code of conduct, you are encouraged to address 66 | the behavior directly with those involved. Many issues can be resolved quickly 67 | and easily, and this gives people more control over the outcome of their 68 | dispute. If you are unable to resolve the matter for any reason, or if the 69 | behavior is threatening or harassing, report it. We are dedicated to providing 70 | an environment where participants feel welcome and safe. 71 | 72 | Reports should be directed to *[PROJECT STEWARD NAME(s) AND EMAIL(s)]*, the 73 | Project Steward(s) for *[PROJECT NAME]*. It is the Project Steward’s duty to 74 | receive and address reported violations of the code of conduct. They will then 75 | work with a committee consisting of representatives from the Open Source 76 | Programs Office and the Google Open Source Strategy team. If for any reason you 77 | are uncomfortable reaching out to the Project Steward, please email 78 | opensource@google.com. 79 | 80 | We will investigate every complaint, but you may not receive a direct response. 81 | We will use our discretion in determining when and how to follow up on reported 82 | incidents, which may range from not taking action to permanent expulsion from 83 | the project and project-sponsored spaces. We will notify the accused of the 84 | report and provide them an opportunity to discuss it before any action is taken. 85 | The identity of the reporter will be omitted from the details of the report 86 | supplied to the accused. In potentially harmful situations, such as ongoing 87 | harassment or threats to anyone's safety, we may take action without notice. 88 | 89 | ## Attribution 90 | 91 | This Code of Conduct is adapted from the Contributor Covenant, version 1.4, 92 | available at 93 | https://www.contributor-covenant.org/version/1/4/code-of-conduct.html 94 | -------------------------------------------------------------------------------- /docs/contributing.md: -------------------------------------------------------------------------------- 1 | # How to Contribute 2 | 3 | We'd love to accept your patches and contributions to this project. There are 4 | just a few small guidelines you need to follow. 5 | 6 | ## Contributor License Agreement 7 | 8 | Contributions to this project must be accompanied by a Contributor License 9 | Agreement. You (or your employer) retain the copyright to your contribution; 10 | this simply gives us permission to use and redistribute your contributions as 11 | part of the project. Head over to to see 12 | your current agreements on file or to sign a new one. 13 | 14 | You generally only need to submit a CLA once, so if you've already submitted one 15 | (even if it was for a different project), you probably don't need to do it 16 | again. 17 | 18 | ## Code reviews 19 | 20 | All submissions, including submissions by project members, require review. We 21 | use GitHub pull requests for this purpose. Consult 22 | [GitHub Help](https://help.github.com/articles/about-pull-requests/) for more 23 | information on using pull requests. 24 | 25 | ## Community Guidelines 26 | 27 | This project follows [Google's Open Source Community 28 | Guidelines](https://opensource.google/conduct/). 29 | -------------------------------------------------------------------------------- /ex0Script.sml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright 2021 DeepMind Technologies Limited. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | https://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | *) 16 | 17 | open HolKernel boolLib bossLib boolSimps Parse 18 | pred_setTheory stringLib 19 | cf0Theory 20 | 21 | val _ = new_theory"ex0"; 22 | 23 | Definition runs_cf1_def: 24 | runs_cf1 = mk_cf 25 | <| agent := { "u"; "n" }; env := { "r"; "s" }; 26 | world := {"ur"; "us"; "nr"; "ns"}; 27 | eval := λa e. a ++ e |> 28 | End 29 | 30 | Theorem sup_closure_example: 31 | sup_closure runs_cf1.world {{"ur"; "us"};{"nr";"ns"}} = 32 | {{"ur"; "us"};{"nr";"ns"}; 33 | {"ur";"us";"nr"};{"ur";"us";"ns"};{"nr";"ns";"ur"};{"nr";"ns";"us"}; 34 | runs_cf1.world} 35 | Proof 36 | rw[SET_EQ_SUBSET] 37 | >- ( 38 | rw[sup_closure_def, runs_cf1_def, SUBSET_DEF, SET_EQ_SUBSET] 39 | \\ fsrw_tac[DNF_ss][] 40 | \\ metis_tac[] ) 41 | \\ rw[sup_closure_def] 42 | \\ srw_tac[DNF_ss][] 43 | \\ EVAL_TAC 44 | QED 45 | 46 | Theorem sub_closure_example: 47 | sub_closure runs_cf1.world {{"ur"; "us"};{"nr";"ns"}} = 48 | {{"ur"; "us"};{"nr";"ns"}; 49 | {"ur"};{"us"};{"nr"};{"ns"};{}} 50 | Proof 51 | rw[SET_EQ_SUBSET] 52 | \\ TRY ( 53 | rw[sub_closure_def, runs_cf1_def] 54 | \\ fsrw_tac[DNF_ss][] 55 | \\ NO_TAC) 56 | \\ rw[sub_closure_def, runs_cf1_def, SUBSET_DEF] 57 | \\ spose_not_then strip_assume_tac \\ fs[EXTENSION] 58 | \\ metis_tac[] 59 | QED 60 | 61 | Theorem runs1_ensure: 62 | ensure runs_cf1 = sup_closure runs_cf1.world {{"ur"; "us"}; {"nr"; "ns"}} 63 | Proof 64 | rw[ensure_def, runs_cf1_def, sup_closure_example] 65 | \\ rw[SET_EQ_SUBSET, SUBSET_DEF] \\ fs[mk_cf_def] 66 | \\ fsrw_tac[DNF_ss][] \\ metis_tac[] 67 | QED 68 | 69 | Theorem runs1_prevent: 70 | prevent runs_cf1 = sub_closure runs_cf1.world {{"ur";"us"};{"nr";"ns"}} 71 | Proof 72 | rw[prevent_def, runs_cf1_def, sub_closure_example] 73 | \\ rw[SUBSET_DEF] 74 | \\ rw[Once EXTENSION] 75 | \\ EQ_TAC \\ rw[] \\ fsrw_tac[DNF_ss][mk_cf_def] 76 | \\ Cases_on`x = {}` \\ fs[] 77 | \\ Cases_on`x` \\ fsrw_tac[DNF_ss][] \\ rw[INSERT_EQ_SING] 78 | \\ Cases_on`t` \\ fsrw_tac[DNF_ss][] \\ rw[INSERT_EQ_SING] 79 | \\ fs[EXTENSION] \\ metis_tac[] 80 | QED 81 | 82 | Theorem runs1_ctrl: 83 | ctrl runs_cf1 = {{"ur";"us"};{"nr";"ns"}} 84 | Proof 85 | rw[ctrl_def, runs1_prevent, runs1_ensure, sub_closure_example, sup_closure_example] 86 | \\ rw[runs_cf1_def] 87 | \\ rw[EXTENSION] \\ metis_tac[] 88 | QED 89 | 90 | Definition runs_cf2_def: 91 | runs_cf2 = mk_cf 92 | <| agent := {"u";"n";"run";"sun"}; 93 | env := {"r";"s"}; 94 | world := runs_cf1.world; 95 | eval := λa e. (if LENGTH a < 2 then EL 0 a else 96 | if EL 0 e = EL 0 a then EL 1 a else EL 2 a)::e |> 97 | End 98 | 99 | Theorem runs2_ctrl: 100 | ctrl runs_cf2 = {{"ur";"us"};{"nr";"ns"};{"ur";"ns"};{"nr";"us"}} 101 | Proof 102 | rw[ctrl_def, ensure_def, prevent_def, runs_cf2_def, runs_cf1_def, SUBSET_DEF] 103 | \\ rw[Once EXTENSION, mk_cf_def] 104 | \\ EQ_TAC \\ rw[] \\ fs[] 105 | \\ spose_not_then strip_assume_tac 106 | \\ fsrw_tac[DNF_ss][] 107 | \\ fs[Once EXTENSION] 108 | \\ metis_tac[] 109 | QED 110 | 111 | Definition runs_cf3_def: 112 | runs_cf3 = 113 | runs_cf2 with <| env := "m" INSERT runs_cf2.env; 114 | world := "m" INSERT runs_cf2.world; 115 | eval := λa e. if a ∈ runs_cf2.agent ∧ e = "m" then "m" else runs_cf2.eval a e |> 116 | End 117 | 118 | Theorem runs3_ensure: 119 | ensure runs_cf3 = 120 | sup_closure runs_cf3.world {{"ur";"us";"m"};{"nr";"ns";"m"};{"ur";"ns";"m"};{"nr";"us";"m"}} 121 | Proof 122 | rw[ensure_def, runs_cf3_def, runs_cf2_def, runs_cf1_def, mk_cf_def] 123 | \\ rw[sup_closure_def] 124 | \\ rw[Once EXTENSION] 125 | \\ qmatch_goalsub_abbrev_tac`x ⊆ w` \\ Cases_on`x ⊆ w` \\ fs[] 126 | \\ EQ_TAC \\ rw[] \\ fsrw_tac[DNF_ss][] 127 | QED 128 | 129 | Theorem runs3_prevent: 130 | prevent runs_cf3 = 131 | sub_closure runs_cf3.world {{"ur";"us"};{"nr";"ns"};{"ur";"ns"};{"nr";"us"}} 132 | Proof 133 | rw[prevent_def, runs_cf3_def, runs_cf2_def, runs_cf1_def, mk_cf_def] 134 | \\ rw[sub_closure_def] 135 | \\ rw[Once EXTENSION] 136 | \\ qmatch_goalsub_abbrev_tac`x ⊆ w` \\ Cases_on`x ⊆ w` \\ fs[] 137 | \\ EQ_TAC >- ( 138 | rw[] \\ fsrw_tac[DNF_ss][] 139 | \\ fsrw_tac[DNF_ss][SUBSET_DEF] 140 | \\ spose_not_then strip_assume_tac \\ fsrw_tac[DNF_ss][Once EXTENSION, Abbr`w`] 141 | \\ metis_tac[] ) 142 | \\ strip_tac \\ rpt BasicProvers.var_eq_tac 143 | THENL (map (exists_tac o fromMLstring) ["n", "u", "sun", "run"]) 144 | \\ rw[] \\ CCONTR_TAC \\ fs[SUBSET_DEF] \\ res_tac \\ fs[] 145 | QED 146 | 147 | fun tails [] = [] 148 | | tails (x::y) = (x,y) :: tails y 149 | 150 | val envs = ["m","us","ur","ns","nr"] 151 | val ineqs = 152 | map (fn (x, r) => 153 | map (fn y => EVAL(mk_eq(fromMLstring x, fromMLstring y))) r) 154 | (tails envs) |> List.concat 155 | 156 | Theorem runs3_ctrl: 157 | ctrl runs_cf3 = ∅ 158 | Proof 159 | rw[ctrl_def, runs3_ensure, runs3_prevent] 160 | \\ rw[sup_closure_def, sub_closure_def, runs_cf3_def, runs_cf2_def, runs_cf1_def] 161 | \\ rw[GSYM DISJOINT_DEF] 162 | \\ rw[IN_DISJOINT] 163 | \\ qmatch_goalsub_abbrev_tac`x ⊆ w` 164 | \\ Cases_on`x ⊆ w` \\ fs[] 165 | \\ CCONTR_TAC \\ fs[] \\ rw[] \\ fs[Abbr`w`] \\ fs[SUBSET_DEF] 166 | \\ metis_tac ineqs 167 | QED 168 | 169 | Theorem runs1_obs: 170 | obs runs_cf1 = union_closure {runs_cf1.world} 171 | Proof 172 | rw[union_closure_sing, obs_def, EXTENSION, SUBSET_DEF, runs_cf1_def, ifs_def, mk_cf_def] 173 | \\ rw[Once EQ_IMP_THM] 174 | \\ fsrw_tac[DNF_ss][] 175 | \\ metis_tac[] 176 | QED 177 | 178 | Theorem wf_runs2[simp]: 179 | wf runs_cf2 180 | Proof 181 | rw[runs_cf2_def, image_def, SUBSET_DEF, runs_cf1_def] 182 | \\ rw[finite_cf_def] 183 | QED 184 | 185 | Theorem wf_runs3[simp]: 186 | wf runs_cf3 187 | Proof 188 | rw[wf_def, runs_cf3_def, runs_cf2_def, runs_cf1_def, mk_cf_def] 189 | \\ rw[finite_cf_def] 190 | QED 191 | 192 | Theorem runs_cf2_world[simp]: 193 | runs_cf2.world = runs_cf1.world 194 | Proof 195 | rw[runs_cf2_def] 196 | QED 197 | 198 | (* TODO: both proofs below could probably be streamlined *) 199 | 200 | Theorem runs2_obs: 201 | obs runs_cf2 = union_closure {{"ur";"nr"}; {"us";"ns"}} 202 | Proof 203 | qmatch_goalsub_abbrev_tac`union_closure s` 204 | \\ `union_closure s = {{}; runs_cf1.world} ∪ s` 205 | by ( 206 | rw[Abbr`s`, union_closure_def, runs_cf1_def] 207 | \\ rw[Once EXTENSION] 208 | \\ Cases_on`x = {}` \\ fsrw_tac[DNF_ss][] 209 | \\ Cases_on`x = {"us";"ns"}` \\ fsrw_tac[DNF_ss][] 210 | >- (qexists_tac`{{"us";"ns"}}` \\ simp[]) 211 | \\ Cases_on`x = {"ur";"nr"}` \\ fsrw_tac[DNF_ss][] 212 | >- (qexists_tac`{{"ur";"nr"}}` \\ simp[]) 213 | \\ Cases_on`x = {"ur";"us";"nr";"ns"}` \\ fsrw_tac[DNF_ss][] 214 | >- (qexists_tac`{{"ur";"nr"};{"us";"ns"}}` \\ simp[] \\ simp[EXTENSION] \\ metis_tac[]) 215 | \\ CCONTR_TAC \\ fs[] \\ rw[] 216 | \\ Cases_on`s` \\ fs[] \\ rw[] \\ fs[] 217 | \\ Cases_on`t` \\ fs[] \\ rw[] \\ fs[] \\ rw[] \\ fs[] \\ rw[] 218 | \\ fs[EXTENSION] \\ metis_tac[] ) 219 | \\ pop_assum SUBST1_TAC 220 | \\ once_rewrite_tac[SET_EQ_SUBSET] 221 | \\ reverse conj_asm2_tac >- ( 222 | simp[SUBSET_DEF, GSYM CONJ_ASSOC] 223 | \\ conj_asm1_tac >- simp[obs_empty] 224 | \\ conj_tac >- ( 225 | first_assum(mp_then Any mp_tac obs_compl) 226 | \\ simp[runs_cf2_def] ) 227 | \\ pop_assum kall_tac 228 | \\ simp[Abbr`s`] 229 | \\ rw[obs_def] \\ TRY (rw[runs_cf2_def, runs_cf1_def, SUBSET_DEF] \\ NO_TAC) 230 | \\ rw[ifs_def] 231 | \\ fs[runs_cf2_def, runs_cf1_def, mk_cf_def] \\ rw[] 232 | \\ TRY(qexists_tac`"u"` \\ rw[] \\ fs[] \\ NO_TAC) 233 | \\ TRY(qexists_tac`"n"` \\ rw[] \\ fs[] \\ NO_TAC) 234 | \\ TRY(qexists_tac`"run"` \\ rw[] \\ fs[] \\ NO_TAC) 235 | \\ TRY(qexists_tac`"sun"` \\ rw[] \\ fs[] \\ NO_TAC)) 236 | \\ rw[SUBSET_DEF] 237 | \\ CCONTR_TAC \\ fs[] 238 | \\ qpat_x_assum`x ∈ _`mp_tac 239 | \\ rw[obs_def, runs_cf2_def] 240 | \\ Cases_on`x ⊆ runs_cf1.world` \\ fs[] 241 | \\ fs[Abbr`s`] 242 | \\ simp[mk_cf_def] 243 | \\ Cases_on`x = {"ur"}` 244 | >- ( 245 | qexists_tac`"n"` \\ qexists_tac`"run"` 246 | \\ simp[ifs_def] \\ rw[] 247 | \\ CCONTR_TAC \\ fs[] \\ rw[] 248 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 249 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 250 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 251 | \\ Cases_on`x = {"nr"}` 252 | >- ( 253 | qexists_tac`"u"` \\ qexists_tac`"sun"` 254 | \\ simp[ifs_def] \\ rw[] 255 | \\ CCONTR_TAC \\ fs[] \\ rw[] 256 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 257 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 258 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 259 | \\ Cases_on`x = {"us"}` 260 | >- ( 261 | qexists_tac`"n"` \\ qexists_tac`"u"` 262 | \\ simp[ifs_def] \\ rw[] 263 | \\ CCONTR_TAC \\ fs[] \\ rw[] 264 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 265 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 266 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 267 | \\ Cases_on`x = {"ns"}` 268 | >- ( 269 | qexists_tac`"u"` \\ qexists_tac`"n"` 270 | \\ simp[ifs_def] \\ rw[] 271 | \\ CCONTR_TAC \\ fs[] \\ rw[] 272 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 273 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 274 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 275 | \\ Cases_on`x = {"ns";"nr"}` 276 | >- ( 277 | qexists_tac`"run"` \\ qexists_tac`"sun"` 278 | \\ simp[ifs_def] \\ rw[] 279 | \\ CCONTR_TAC \\ fs[] \\ rw[] 280 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 281 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 282 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 283 | \\ Cases_on`x = {"us";"ur"}` 284 | >- ( 285 | qexists_tac`"run"` \\ qexists_tac`"sun"` 286 | \\ simp[ifs_def] \\ rw[] 287 | \\ CCONTR_TAC \\ fs[] \\ rw[] 288 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 289 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 290 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 291 | \\ Cases_on`x = {"ur";"ns"}` 292 | >- ( 293 | qexists_tac`"u"` \\ qexists_tac`"n"` 294 | \\ simp[ifs_def] \\ rw[] 295 | \\ CCONTR_TAC \\ fs[] \\ rw[] 296 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 297 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 298 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 299 | \\ Cases_on`x = {"us";"nr"}` 300 | >- ( 301 | qexists_tac`"u"` \\ qexists_tac`"n"` 302 | \\ simp[ifs_def] \\ rw[] 303 | \\ CCONTR_TAC \\ fs[] \\ rw[] 304 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 305 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 306 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 307 | \\ Cases_on`x = {"us";"ur";"ns"}` 308 | >- ( 309 | qexists_tac`"n"` \\ qexists_tac`"run"` 310 | \\ simp[ifs_def] \\ rw[] 311 | \\ CCONTR_TAC \\ fs[] \\ rw[] 312 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 313 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 314 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 315 | \\ Cases_on`x = {"us";"ur";"nr"}` 316 | >- ( 317 | qexists_tac`"n"` \\ qexists_tac`"sun"` 318 | \\ simp[ifs_def] \\ rw[] 319 | \\ CCONTR_TAC \\ fs[] \\ rw[] 320 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 321 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 322 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 323 | \\ Cases_on`x = {"ns";"ur";"nr"}` 324 | >- ( 325 | qexists_tac`"u"` \\ qexists_tac`"run"` 326 | \\ simp[ifs_def] \\ rw[] 327 | \\ CCONTR_TAC \\ fs[] \\ rw[] 328 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 329 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 330 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 331 | \\ Cases_on`x = {"ns";"us";"nr"}` 332 | >- ( 333 | qexists_tac`"u"` \\ qexists_tac`"sun"` 334 | \\ simp[ifs_def] \\ rw[] 335 | \\ CCONTR_TAC \\ fs[] \\ rw[] 336 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 337 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 338 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 339 | \\ `F` suffices_by rw[] 340 | \\ qpat_x_assum`x ⊆ _`mp_tac 341 | \\ fs[runs_cf1_def] 342 | \\ simp[GSYM IN_POW] 343 | \\ simp[POW_EQNS] 344 | \\ fs[INSERT_COMM] 345 | QED 346 | 347 | Theorem runs3_obs: 348 | obs runs_cf3 = union_closure {{"ur";"nr"};{"us";"ns"};{"m"}} 349 | Proof 350 | qmatch_goalsub_abbrev_tac`union_closure s` 351 | \\ `union_closure s = s ∪ 352 | {{}; runs_cf3.world; {"ur";"nr";"us";"ns"}; {"ur";"nr";"m"}; {"us";"ns";"m"}}` 353 | by ( 354 | rw[Abbr`s`, runs_cf3_def, runs_cf2_def, runs_cf1_def] 355 | \\ rw[Once EXTENSION] 356 | \\ rw[union_closure_def] 357 | \\ Cases_on`x = {}` \\ fsrw_tac[DNF_ss][] 358 | \\ Cases_on`x = {"m"}` \\ fsrw_tac[DNF_ss][] 359 | >- (qexists_tac`{{"m"}}` \\ simp[]) 360 | \\ qmatch_goalsub_abbrev_tac`x = s ∨ _` 361 | \\ Cases_on`x = s` \\ fsrw_tac[DNF_ss][] 362 | >- (qexists_tac`{s}` \\ simp[]) 363 | \\ qunabbrev_tac`s` 364 | \\ qmatch_goalsub_abbrev_tac`x = s ∨ _` 365 | \\ Cases_on`x = s` \\ fsrw_tac[DNF_ss][] 366 | >- (qexists_tac`{s}` \\ simp[]) 367 | \\ qunabbrev_tac`s` 368 | \\ qmatch_goalsub_abbrev_tac`x = s ∨ _` 369 | \\ Cases_on`x = s` \\ fsrw_tac[DNF_ss][] 370 | >- ( 371 | qmatch_goalsub_abbrev_tac`_ ⊆ t` 372 | \\ qexists_tac`t` 373 | \\ simp[Abbr`s`,Abbr`t`] 374 | \\ simp[EXTENSION] \\ PROVE_TAC[]) 375 | \\ qunabbrev_tac`s` 376 | \\ qmatch_goalsub_abbrev_tac`x = s ∨ _` 377 | \\ Cases_on`x = s` \\ fsrw_tac[DNF_ss][] 378 | >- ( 379 | qmatch_goalsub_abbrev_tac`_ ⊆ {s1;s2;s3}` 380 | \\ qexists_tac`{s1;s2}` 381 | \\ simp[Abbr`s`,Abbr`s1`,Abbr`s2`] 382 | \\ simp[EXTENSION] \\ PROVE_TAC[]) 383 | \\ qunabbrev_tac`s` 384 | \\ qmatch_goalsub_abbrev_tac`x = s ∨ _` 385 | \\ Cases_on`x = s` \\ fsrw_tac[DNF_ss][] 386 | >- ( 387 | qmatch_goalsub_abbrev_tac`_ ⊆ {s1;s2;s3}` 388 | \\ qexists_tac`{s1;s3}` 389 | \\ simp[Abbr`s`,Abbr`s1`,Abbr`s3`] 390 | \\ simp[EXTENSION] \\ PROVE_TAC[]) 391 | \\ qunabbrev_tac`s` 392 | \\ qmatch_goalsub_abbrev_tac`x = s` 393 | \\ Cases_on`x = s` \\ fsrw_tac[DNF_ss][] 394 | >- ( 395 | qmatch_goalsub_abbrev_tac`_ ⊆ {s1;s2;s3}` 396 | \\ qexists_tac`{s2;s3}` 397 | \\ simp[Abbr`s`,Abbr`s2`,Abbr`s3`] 398 | \\ simp[EXTENSION] \\ PROVE_TAC[]) 399 | \\ qunabbrev_tac`s` 400 | \\ rw[GSYM IN_POW] 401 | \\ simp[POW_EQNS] 402 | \\ CCONTR_TAC \\ fs[] \\ rw[] \\ fs[] \\ fs[EXTENSION] 403 | \\ metis_tac[]) 404 | \\ pop_assum SUBST1_TAC 405 | \\ qunabbrev_tac `s` 406 | \\ simp[SimpRHS, runs_cf3_def, runs_cf2_def, runs_cf1_def] 407 | \\ once_rewrite_tac[SET_EQ_SUBSET] 408 | \\ reverse conj_asm2_tac >- ( 409 | simp[SUBSET_DEF, GSYM CONJ_ASSOC] 410 | \\ `∅ ∈ obs runs_cf3` by simp[obs_empty] 411 | \\ first_assum(mp_then Any mp_tac obs_compl) 412 | \\ simp[] 413 | \\ simp[Once runs_cf3_def, runs_cf2_def, runs_cf1_def] 414 | \\ strip_tac 415 | \\ `{"m"} ∈ obs runs_cf3` 416 | by ( 417 | simp[obs_def] 418 | \\ conj_tac >- EVAL_TAC 419 | \\ rpt gen_tac \\ strip_tac 420 | \\ qexists_tac`a1` \\ simp[] 421 | \\ simp[ifs_def] 422 | \\ ntac 2 (pop_assum mp_tac) 423 | \\ EVAL_TAC 424 | \\ rw[]) 425 | \\ first_assum (mp_then Any mp_tac obs_compl) 426 | \\ simp[] 427 | \\ simp[Once runs_cf3_def, runs_cf2_def, runs_cf1_def, INSERT_COMM] 428 | \\ strip_tac 429 | \\ `{"ur";"nr"} ∈ obs runs_cf3` 430 | by ( 431 | simp[obs_def] 432 | \\ conj_tac >- EVAL_TAC 433 | \\ rpt gen_tac \\ strip_tac 434 | \\ simp[ifs_def, runs_cf3_def, runs_cf2_def, mk_cf_def] 435 | \\ fs[runs_cf3_def, runs_cf2_def, runs_cf1_def] 436 | \\ TRY(qexists_tac`"u"` \\ rw[] \\ fs[] \\ NO_TAC) 437 | \\ TRY(qexists_tac`"n"` \\ rw[] \\ fs[] \\ NO_TAC) 438 | \\ TRY(qexists_tac`"run"` \\ rw[] \\ fs[] \\ NO_TAC) 439 | \\ TRY(qexists_tac`"sun"` \\ rw[] \\ fs[] \\ NO_TAC)) 440 | \\ first_assum (mp_then Any mp_tac obs_compl) 441 | \\ simp[] 442 | \\ simp[Once runs_cf3_def, runs_cf2_def, runs_cf1_def, INSERT_COMM] 443 | \\ strip_tac 444 | \\ `{"us";"ns"} ∈ obs runs_cf3` 445 | by ( 446 | simp[obs_def] 447 | \\ conj_tac >- EVAL_TAC 448 | \\ rpt gen_tac \\ strip_tac 449 | \\ simp[ifs_def, runs_cf3_def, runs_cf2_def, mk_cf_def] 450 | \\ fs[runs_cf3_def, runs_cf2_def, runs_cf1_def] 451 | \\ TRY(qexists_tac`"u"` \\ rw[] \\ fs[] \\ NO_TAC) 452 | \\ TRY(qexists_tac`"n"` \\ rw[] \\ fs[] \\ NO_TAC) 453 | \\ TRY(qexists_tac`"run"` \\ rw[] \\ fs[] \\ NO_TAC) 454 | \\ TRY(qexists_tac`"sun"` \\ rw[] \\ fs[] \\ NO_TAC)) 455 | \\ first_assum (mp_then Any mp_tac obs_compl) 456 | \\ simp[] 457 | \\ simp[Once runs_cf3_def, runs_cf2_def, runs_cf1_def, INSERT_COMM]) 458 | \\ rw[SUBSET_DEF] 459 | \\ CCONTR_TAC \\ fs[] 460 | \\ qpat_x_assum`x ∈ _`mp_tac 461 | \\ rw[obs_def, runs_cf3_def, runs_cf2_def, runs_cf1_def, mk_cf_def] 462 | \\ simp[Once (GSYM IMP_DISJ_THM)] 463 | \\ simp[GSYM IN_POW] 464 | \\ simp[POW_EQNS] 465 | \\ fs[INSERT_COMM] 466 | \\ Cases_on`x = {"ns"}` \\ fs[] 467 | >- ( 468 | qexists_tac`"u"` \\ qexists_tac`"n"` 469 | \\ simp[ifs_def] \\ rw[] 470 | \\ CCONTR_TAC \\ fs[] \\ rw[] 471 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 472 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 473 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 474 | \\ Cases_on`x = {"nr"}` \\ fs[] 475 | >- ( 476 | qexists_tac`"u"` \\ qexists_tac`"sun"` 477 | \\ simp[ifs_def] \\ rw[] 478 | \\ CCONTR_TAC \\ fs[] \\ rw[] 479 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 480 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 481 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 482 | \\ Cases_on`x = {"us"}` \\ fs[] 483 | >- ( 484 | qexists_tac`"n"` \\ qexists_tac`"u"` 485 | \\ simp[ifs_def] \\ rw[] 486 | \\ CCONTR_TAC \\ fs[] \\ rw[] 487 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 488 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 489 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 490 | \\ Cases_on`x = {"ur"}` \\ fs[] 491 | >- ( 492 | qexists_tac`"n"` \\ qexists_tac`"run"` 493 | \\ simp[ifs_def] \\ rw[] 494 | \\ CCONTR_TAC \\ fs[] \\ rw[] 495 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 496 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 497 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 498 | \\ Cases_on`x = {"ns";"nr"}` \\ fs[] 499 | >- ( 500 | qexists_tac`"run"` \\ qexists_tac`"sun"` 501 | \\ simp[ifs_def] \\ rw[] 502 | \\ CCONTR_TAC \\ fs[] \\ rw[] 503 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 504 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 505 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 506 | \\ Cases_on`x = {"us";"ur"}` \\ fs[] 507 | >- ( 508 | qexists_tac`"run"` \\ qexists_tac`"sun"` 509 | \\ simp[ifs_def] \\ rw[] 510 | \\ CCONTR_TAC \\ fs[] \\ rw[] 511 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 512 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 513 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 514 | \\ Cases_on`x = {"ur";"ns"}` \\ fs[] 515 | >- ( 516 | qexists_tac`"u"` \\ qexists_tac`"n"` 517 | \\ simp[ifs_def] \\ rw[] 518 | \\ CCONTR_TAC \\ fs[] \\ rw[] 519 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 520 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 521 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 522 | \\ Cases_on`x = {"us";"nr"}` \\ fs[] 523 | >- ( 524 | qexists_tac`"u"` \\ qexists_tac`"n"` 525 | \\ simp[ifs_def] \\ rw[] 526 | \\ CCONTR_TAC \\ fs[] \\ rw[] 527 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 528 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 529 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 530 | \\ Cases_on`x = {"us";"ur";"ns"}` \\ fs[INSERT_COMM] 531 | >- ( 532 | qexists_tac`"n"` \\ qexists_tac`"run"` 533 | \\ simp[ifs_def] \\ rw[] 534 | \\ CCONTR_TAC \\ fs[] \\ rw[] 535 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 536 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 537 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 538 | \\ Cases_on`x = {"us";"ur";"nr"}` \\ fs[INSERT_COMM] 539 | >- ( 540 | qexists_tac`"n"` \\ qexists_tac`"sun"` 541 | \\ simp[ifs_def] \\ rw[] 542 | \\ CCONTR_TAC \\ fs[] \\ rw[] 543 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 544 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 545 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 546 | \\ Cases_on`x = {"ns";"ur";"nr"}` \\ fs[INSERT_COMM] 547 | >- ( 548 | qexists_tac`"u"` \\ qexists_tac`"run"` 549 | \\ simp[ifs_def] \\ rw[] 550 | \\ CCONTR_TAC \\ fs[] \\ rw[] 551 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 552 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 553 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 554 | \\ Cases_on`x = {"ns";"us";"nr"}` \\ fs[INSERT_COMM] 555 | >- ( 556 | qexists_tac`"u"` \\ qexists_tac`"sun"` 557 | \\ simp[ifs_def] \\ rw[] 558 | \\ CCONTR_TAC \\ fs[] \\ rw[] 559 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 560 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 561 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 562 | \\ fs[INSERT_COMM, GSYM DISJ_ASSOC] 563 | \\ Cases_on`x = {"m"; "ns"}` \\ fs[] 564 | >- ( 565 | qexists_tac`"u"` \\ qexists_tac`"n"` 566 | \\ simp[ifs_def] \\ rw[] 567 | \\ CCONTR_TAC \\ fs[] \\ rw[] 568 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 569 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 570 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 571 | \\ Cases_on`x = {"m"; "nr"}` \\ fs[] 572 | >- ( 573 | qexists_tac`"u"` \\ qexists_tac`"sun"` 574 | \\ simp[ifs_def] \\ rw[] 575 | \\ CCONTR_TAC \\ fs[] \\ rw[] 576 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 577 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 578 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 579 | \\ Cases_on`x = {"m"; "us"}` \\ fs[] 580 | >- ( 581 | qexists_tac`"n"` \\ qexists_tac`"u"` 582 | \\ simp[ifs_def] \\ rw[] 583 | \\ CCONTR_TAC \\ fs[] \\ rw[] 584 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 585 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 586 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 587 | \\ Cases_on`x = {"m"; "ur"}` \\ fs[] 588 | >- ( 589 | qexists_tac`"n"` \\ qexists_tac`"run"` 590 | \\ simp[ifs_def] \\ rw[] 591 | \\ CCONTR_TAC \\ fs[] \\ rw[] 592 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 593 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 594 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 595 | \\ Cases_on`x = {"m"; "ns";"nr"}` \\ fs[] 596 | >- ( 597 | qexists_tac`"run"` \\ qexists_tac`"sun"` 598 | \\ simp[ifs_def] \\ rw[] 599 | \\ CCONTR_TAC \\ fs[] \\ rw[] 600 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 601 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 602 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 603 | \\ Cases_on`x = {"m";"us";"ur"}` \\ fs[] 604 | >- ( 605 | qexists_tac`"run"` \\ qexists_tac`"sun"` 606 | \\ simp[ifs_def] \\ rw[] 607 | \\ CCONTR_TAC \\ fs[] \\ rw[] 608 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 609 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 610 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 611 | \\ Cases_on`x = {"m";"ur";"ns"}` \\ fs[] 612 | >- ( 613 | qexists_tac`"u"` \\ qexists_tac`"n"` 614 | \\ simp[ifs_def] \\ rw[] 615 | \\ CCONTR_TAC \\ fs[] \\ rw[] 616 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 617 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 618 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 619 | \\ Cases_on`x = {"m";"us";"nr"}` \\ fs[] 620 | >- ( 621 | qexists_tac`"u"` \\ qexists_tac`"n"` 622 | \\ simp[ifs_def] \\ rw[] 623 | \\ CCONTR_TAC \\ fs[] \\ rw[] 624 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 625 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 626 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 627 | \\ Cases_on`x = {"m";"us";"ur";"ns"}` \\ fs[INSERT_COMM] 628 | >- ( 629 | qexists_tac`"n"` \\ qexists_tac`"run"` 630 | \\ simp[ifs_def] \\ rw[] 631 | \\ CCONTR_TAC \\ fs[] \\ rw[] 632 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 633 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 634 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 635 | \\ Cases_on`x = {"m";"us";"ur";"nr"}` \\ fs[INSERT_COMM] 636 | >- ( 637 | qexists_tac`"n"` \\ qexists_tac`"sun"` 638 | \\ simp[ifs_def] \\ rw[] 639 | \\ CCONTR_TAC \\ fs[] \\ rw[] 640 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 641 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 642 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 643 | \\ Cases_on`x = {"m";"ns";"ur";"nr"}` \\ fs[INSERT_COMM] 644 | >- ( 645 | qexists_tac`"u"` \\ qexists_tac`"run"` 646 | \\ simp[ifs_def] \\ rw[] 647 | \\ CCONTR_TAC \\ fs[] \\ rw[] 648 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 649 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 650 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 651 | \\ Cases_on`x = {"m";"ns";"us";"nr"}` \\ fs[INSERT_COMM] 652 | >- ( 653 | qexists_tac`"u"` \\ qexists_tac`"sun"` 654 | \\ simp[ifs_def] \\ rw[] 655 | \\ CCONTR_TAC \\ fs[] \\ rw[] 656 | \\ pop_assum mp_tac \\ simp[] \\ fs[] 657 | \\ TRY(qexists_tac`"s"` \\ simp[] \\ NO_TAC) 658 | \\ TRY(qexists_tac`"r"` \\ simp[] \\ NO_TAC)) 659 | QED 660 | 661 | Definition runs_cf4_def: 662 | runs_cf4 = mk_cf 663 | <| world := runs_cf1.world; agent := {""}; env := runs_cf1.world; eval := λa e. e |> 664 | End 665 | 666 | Definition runs_cf5_def: 667 | runs_cf5 = mk_cf 668 | <| world := runs_cf1.world; env := {""}; agent := runs_cf1.world; eval := λa e. a |> 669 | End 670 | 671 | (* TODO: facts about runs_cf4, runs_cf5 *) 672 | 673 | val _ = export_theory(); 674 | -------------------------------------------------------------------------------- /ex1Script.sml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright 2021 DeepMind Technologies Limited. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | https://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | *) 16 | 17 | open HolKernel boolLib bossLib boolSimps Parse 18 | pred_setTheory categoryTheory functorTheory 19 | cf0Theory ex0Theory matrixTheory matrixLib cf1Theory 20 | 21 | val _ = new_theory"ex1"; 22 | 23 | Definition test_world_def: 24 | test_world = "F" INSERT BIGUNION (IMAGE (λg. {g;g++"+";g++"-"}) {"A";"B";"C";"D"}) 25 | End 26 | 27 | Theorem test_world_eq = EVAL ``test_world`` 28 | 29 | Definition test_today_def: 30 | test_today = mk_cf 31 | <| world := test_world; 32 | env := {"t";"d";"o"}; 33 | agent := {"s";"i"}; 34 | eval := λa e. if a = "i" then "C+" else 35 | if e = "t" then "A-" else 36 | if e = "d" then "B+" else "D-" |> 37 | End 38 | 39 | Definition test_yesterday_def: 40 | test_yesterday = mk_cf 41 | <| world := test_world; 42 | env := test_today.env; 43 | agent := "c" INSERT test_today.agent; 44 | eval := λa e. if a = "c" then "A+" else test_today.eval a e |> 45 | End 46 | 47 | Definition test_demanding_def: 48 | test_demanding = mk_cf 49 | <| world := test_world; 50 | env := test_today.env DELETE "t"; 51 | agent := test_today.agent; 52 | eval := test_today.eval |> 53 | End 54 | 55 | Theorem test_yesterday_in_chu_objects[simp]: 56 | test_yesterday ∈ chu_objects test_world 57 | Proof 58 | rw[test_yesterday_def, chu_objects_def, 59 | finite_cf_def, SUBSET_DEF] 60 | \\ TRY (pop_assum mp_tac) 61 | \\ EVAL_TAC 62 | \\ rw[] 63 | QED 64 | 65 | Theorem test_demanding_in_chu_objects[simp]: 66 | test_demanding ∈ chu_objects test_world 67 | Proof 68 | rw[test_demanding_def, chu_objects_def, 69 | finite_cf_def, SUBSET_DEF] 70 | \\ TRY (pop_assum mp_tac) 71 | \\ EVAL_TAC 72 | \\ rw[] 73 | QED 74 | 75 | Theorem morphism_today_yesterday: 76 | is_chu_morphism test_today test_yesterday 77 | (mk_chu_morphism test_today test_yesterday <| map_env := I; map_agent := I |>).map 78 | Proof 79 | simp[is_chu_morphism_def] 80 | \\ simp[mk_chu_morphism_def] 81 | \\ rw[test_today_def, test_yesterday_def, categoryTheory.restrict_def, mk_cf_def] 82 | QED 83 | 84 | Theorem morphism_today_demanding: 85 | is_chu_morphism test_today test_demanding 86 | (mk_chu_morphism test_today test_demanding <| map_env := I; map_agent := I |>).map 87 | Proof 88 | simp[is_chu_morphism_def] 89 | \\ simp[mk_chu_morphism_def] 90 | \\ rw[test_today_def, test_demanding_def, categoryTheory.restrict_def, mk_cf_def] 91 | QED 92 | 93 | Theorem no_morphisms_yesterday_demanding: 94 | ¬is_chu_morphism test_yesterday test_demanding m ∧ 95 | ¬is_chu_morphism test_demanding test_yesterday m 96 | Proof 97 | Cases_on`m` 98 | \\ qmatch_goalsub_rename_tac`chu_morphism_map f g` 99 | \\ simp[is_chu_morphism_def] 100 | \\ conj_tac 101 | \\ (qmatch_abbrev_tac`a ∨ b` \\ Cases_on`a = T` \\ fs[Abbr`a`, Abbr`b`]) 102 | \\ (qmatch_abbrev_tac`a ∨ b` \\ Cases_on`a = T` \\ fs[Abbr`a`, Abbr`b`]) 103 | \\ (qmatch_abbrev_tac`a ∨ b` \\ Cases_on`a = T` \\ fs[Abbr`a`, Abbr`b`] 104 | >- metis_tac[] \\ disj2_tac) 105 | \\ (qmatch_abbrev_tac`a ∨ b` \\ Cases_on`a = T` \\ fs[Abbr`a`, Abbr`b`] 106 | >- metis_tac[] \\ disj2_tac) 107 | \\ fs[GSYM IMP_DISJ_THM] 108 | \\ fs[test_yesterday_def, test_demanding_def, test_today_def, mk_cf_def] 109 | >- ( 110 | qexists_tac`"c"` \\ simp[] 111 | \\ qexists_tac`"d"` \\ rw[] ) 112 | \\ qexists_tac`if f "i" = "i" then "s" else "i"` 113 | \\ qexists_tac`"t"` 114 | \\ simp[] 115 | \\ IF_CASES_TAC \\ simp[] \\ rw[] \\ fs[] 116 | \\ metis_tac[] 117 | QED 118 | 119 | Definition handshake_def: 120 | handshake = mk_cf 121 | <| world := {""; "*"}; 122 | agent := {""; "*"}; 123 | env := {""; "*"}; 124 | eval := λa e. DROP 1 (a ++ e) |> 125 | End 126 | 127 | Definition bothsing_def: 128 | bothsing = mk_cf 129 | <| world := {""}; 130 | agent := {""}; 131 | env := {""}; 132 | eval := K (K "") |> 133 | End 134 | 135 | Theorem morphism_handshake_bothsing: 136 | is_chu_morphism handshake bothsing 137 | (mk_chu_morphism handshake bothsing <| map_agent := K ""; map_env := K "" |>).map 138 | Proof 139 | simp[is_chu_morphism_def, handshake_def, bothsing_def, mk_chu_morphism_def] 140 | \\ rw[] \\ EVAL_TAC 141 | QED 142 | 143 | Theorem morphism_bothsing_handshake: 144 | is_chu_morphism bothsing handshake 145 | (mk_chu_morphism bothsing handshake <| map_agent := K ""; map_env := K "" |>).map 146 | Proof 147 | simp[is_chu_morphism_def, handshake_def, bothsing_def, mk_chu_morphism_def] 148 | \\ rw[] \\ EVAL_TAC 149 | QED 150 | 151 | Definition sum_exc_def: 152 | sum_exc = mk_cf 153 | <| world := IMAGE toString (count 13); 154 | agent := IMAGE toString (count 2); 155 | env := IMAGE toString (count 2); 156 | eval := λa e. toString (toNum (a) * 2 + toNum(e)) |> 157 | End 158 | 159 | Definition sum_exd_def: 160 | sum_exd = mk_cf 161 | <| world := IMAGE toString (count 13); 162 | agent := IMAGE toString (count 3); 163 | env := IMAGE toString (count 3); 164 | eval := λa e. toString (4 + toNum(a) * 3 + toNum(e)) |> 165 | End 166 | 167 | Theorem cf_matrix_sum_exc: 168 | cf_matrix sum_exc = 169 | [ ["0"; "1"]; 170 | ["2"; "3"] ] 171 | Proof 172 | rw[cf_matrix_def, sum_exc_def] 173 | \\ CONV_TAC(DEPTH_CONV(fn tm => 174 | if pred_setSyntax.is_image tm then EVAL tm else 175 | raise UNCHANGED)) 176 | \\ simp[QSORT_char_lt_SET_TO_LIST_init, mk_cf_def] 177 | \\ EVAL_TAC 178 | QED 179 | 180 | Theorem cf_matrix_sum_exd: 181 | cf_matrix sum_exd = 182 | [ ["4"; "5"; "6"]; 183 | ["7"; "8"; "9"]; 184 | ["10"; "11"; "12"] ] 185 | Proof 186 | rw[cf_matrix_def, sum_exd_def] 187 | \\ CONV_TAC(DEPTH_CONV(fn tm => 188 | if pred_setSyntax.is_image tm then EVAL tm else 189 | raise UNCHANGED)) 190 | \\ simp[mk_cf_def] 191 | \\ qsort_set_to_list_tac 192 | \\ EVAL_TAC 193 | QED 194 | 195 | Theorem cf_matrix_sum_exc_exd: 196 | cf_matrix (sum sum_exc sum_exd) = 197 | [ ["0"; "0"; "0"; "1"; "1"; "1"]; 198 | ["2"; "2"; "2"; "3"; "3"; "3"]; 199 | ["4"; "5"; "6"; "4"; "5"; "6"]; 200 | ["7"; "8"; "9"; "7"; "8"; "9"]; 201 | ["10"; "11"; "12"; "10"; "11"; "12"]] 202 | Proof 203 | simp[cf_matrix_def] 204 | \\ simp[sum_def] 205 | \\ simp[sum_exc_def, sum_exd_def] 206 | \\ CONV_TAC(DEPTH_CONV(fn tm => 207 | if pred_setSyntax.is_image tm then EVAL tm else 208 | raise UNCHANGED)) 209 | \\ simp[INSERT_UNION, mk_cf_def] 210 | \\ qsort_set_to_list_tac 211 | \\ EVAL_TAC 212 | QED 213 | 214 | Theorem cf_matrix_prod_exc_exd: 215 | cf_matrix (prod sum_exc sum_exd) = 216 | [ ["0"; "1"; "4"; "5"; "6"]; 217 | ["0"; "1"; "7"; "8"; "9"]; 218 | ["0"; "1"; "10"; "11"; "12"]; 219 | ["2"; "3"; "4"; "5"; "6"]; 220 | ["2"; "3"; "7"; "8"; "9"]; 221 | ["2"; "3"; "10"; "11"; "12"] ] 222 | Proof 223 | simp[cf_matrix_def] 224 | \\ simp[prod_def] 225 | \\ simp[sum_exc_def, sum_exd_def] 226 | \\ CONV_TAC(DEPTH_CONV(fn tm => 227 | if pred_setSyntax.is_image tm then EVAL tm else 228 | raise UNCHANGED)) 229 | \\ simp[INSERT_UNION, mk_cf_def] 230 | \\ qsort_set_to_list_tac 231 | \\ EVAL_TAC 232 | QED 233 | 234 | Theorem cf_matrix_runs_cf2: 235 | cf_matrix runs_cf2 = 236 | [ 237 | (* n *) ["nr"; "ns"]; 238 | (* u *) ["ur"; "us"]; 239 | (* run *)["ur"; "ns"]; 240 | (* sun *)["nr"; "us"]; 241 | ] 242 | Proof 243 | simp[cf_matrix_def, runs_cf2_def] 244 | \\ qsort_set_to_list_tac 245 | \\ EVAL_TAC 246 | QED 247 | 248 | Definition run_cf_def: 249 | run_cf = mk_cf 250 | <| world := runs_cf1.world; 251 | agent := {"u"; "n"}; 252 | env := {"r"}; 253 | eval := (++) |> 254 | End 255 | 256 | Definition sun_cf_def: 257 | sun_cf = mk_cf 258 | <| world := runs_cf1.world; 259 | agent := {"u"; "n"}; 260 | env := {"s"}; 261 | eval := (++) |> 262 | End 263 | 264 | Theorem wf_run_sun[simp]: 265 | wf run_cf ∧ wf sun_cf 266 | Proof 267 | rw[run_cf_def, sun_cf_def, image_def] 268 | \\ rw[SUBSET_DEF] 269 | \\ EVAL_TAC 270 | QED 271 | 272 | Theorem run_sun_world[simp]: 273 | run_cf.world = runs_cf1.world ∧ 274 | sun_cf.world = runs_cf1.world 275 | Proof 276 | rw[run_cf_def, sun_cf_def] 277 | QED 278 | 279 | Theorem run_sun_in_chu_objects[simp]: 280 | run_cf ∈ chu_objects runs_cf1.world ∧ 281 | sun_cf ∈ chu_objects runs_cf1.world 282 | Proof 283 | rw[chu_objects_def] 284 | QED 285 | 286 | Theorem runs2_in_chu_objects[simp]: 287 | runs_cf2 ∈ chu_objects runs_cf1.world 288 | Proof 289 | rw[chu_objects_def] 290 | QED 291 | 292 | Theorem runs_cf2_as_product: 293 | runs_cf2 ≅ run_cf && sun_cf -: chu (runs_cf1.world) 294 | Proof 295 | simp[iso_objs_thm] 296 | \\ qexists_tac`mk_chu_morphism (runs_cf2) (run_cf && sun_cf) 297 | <| map_agent := 298 | (λa. encode_pair (if a = "u" ∨ a = "run" then "u" else "n", 299 | if a = "n" ∨ a = "run" then "n" else "u")); 300 | map_env := TL |>` 301 | \\ simp[maps_to_in_def] 302 | \\ simp[pre_chu_def] 303 | \\ simp[chu_iso_bij] 304 | \\ reverse conj_asm1_tac \\ simp[] 305 | >- ( 306 | simp[mk_chu_morphism_def] 307 | \\ conj_tac 308 | >- ( 309 | simp[BIJ_IFF_INV] 310 | \\ conj_tac >- rw[runs_cf2_def, restrict_def, prod_def, run_cf_def, sun_cf_def] 311 | \\ qexists_tac`λa. 312 | let a = DROP 2 a in 313 | if HD a = HD (TL a) then TAKE 1 a else 314 | if HD a = #"u" then "run" else "sun"` 315 | \\ rw[runs_cf2_def, run_cf_def, sun_cf_def, prod_def, pairTheory.EXISTS_PROD] 316 | \\ rpt (pop_assum mp_tac) 317 | \\ EVAL_TAC ) 318 | >- ( 319 | simp[BIJ_IFF_INV] 320 | \\ conj_tac >- (EVAL_TAC \\ rw[] \\ rw[]) 321 | \\ qexists_tac`λe. if e = "r" then "lr" else "rs"` 322 | \\ rw[runs_cf2_def, run_cf_def, sun_cf_def, prod_def, pairTheory.EXISTS_PROD] 323 | \\ rpt(pop_assum mp_tac) 324 | \\ EVAL_TAC )) 325 | \\ simp[mk_chu_morphism_def] 326 | \\ simp[is_chu_morphism_def] 327 | \\ rw[runs_cf2_def, run_cf_def, sun_cf_def, restrict_def, prod_def] \\ fs[] \\ rw[] 328 | \\ rpt (pop_assum mp_tac) \\ EVAL_TAC 329 | QED 330 | 331 | val _ = export_theory(); 332 | -------------------------------------------------------------------------------- /ex2Script.sml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright 2021 DeepMind Technologies Limited. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | https://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | *) 16 | 17 | open HolKernel boolLib bossLib boolSimps Parse 18 | rich_listTheory categoryTheory cf0Theory cf1Theory cf2Theory 19 | 20 | val _ = new_theory"ex2"; 21 | 22 | Definition sym_cf_def: 23 | sym_cf = mk_cf 24 | <| world := {"";"."}; 25 | agent := {"";"."}; 26 | env := {"";"."}; 27 | eval := λa e. if a = e then "." else "" |> 28 | End 29 | 30 | Definition flip_morphism_def: 31 | flip_morphism = mk_chu_morphism sym_cf sym_cf 32 | <| map_agent := λa. REPLICATE (1 - LENGTH a) #"." ; 33 | map_env := λe. REPLICATE (1 - LENGTH e) #"." |> 34 | End 35 | 36 | Theorem flip_morphism_dom_cod[simp]: 37 | flip_morphism.dom = sym_cf ∧ 38 | flip_morphism.cod = sym_cf 39 | Proof 40 | EVAL_TAC 41 | QED 42 | 43 | Theorem sym_cf_in_chu_objects[simp]: 44 | sym_cf ∈ chu_objects sym_cf.world 45 | Proof 46 | rw[chu_objects_def, wf_def] 47 | \\ fs[sym_cf_def, mk_cf_def, finite_cf_def] 48 | QED 49 | 50 | Theorem is_morphism_flip[simp]: 51 | is_chu_morphism sym_cf sym_cf flip_morphism.map 52 | Proof 53 | rw[is_chu_morphism_def, flip_morphism_def, mk_chu_morphism_def, sym_cf_def] 54 | \\ rw[restrict_def, REPLICATE_compute, mk_cf_def] 55 | QED 56 | 57 | Theorem not_homotopic_flip_id: 58 | ¬ homotopic sym_cf.world flip_morphism (id sym_cf -: chu sym_cf.world) 59 | Proof 60 | rw[homotopic_def] 61 | \\ simp[pre_chu_def] 62 | \\ rw[hom_comb_def] 63 | \\ rw[is_chu_morphism_def] 64 | \\ ntac 4 disj2_tac 65 | \\ qexists_tac`""` 66 | \\ qexists_tac`""` 67 | \\ EVAL_TAC 68 | QED 69 | 70 | val _ = export_theory(); 71 | -------------------------------------------------------------------------------- /ex4Script.sml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright 2021 DeepMind Technologies Limited. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | https://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | *) 16 | 17 | open HolKernel boolLib bossLib boolSimps Parse 18 | pairTheory pred_setTheory categoryTheory 19 | cf0Theory matrixTheory matrixLib cf1Theory cf2Theory cf4Theory 20 | 21 | val _ = new_theory"ex4"; 22 | 23 | Definition prime_env_def: 24 | prime_env = {"P"; "N"} 25 | End 26 | 27 | Definition prime_agent_sensitive_def: 28 | prime_agent_sensitive = {"A"; "I"} 29 | End 30 | 31 | Definition prime_agent_coarse_def: 32 | prime_agent_coarse = prime_env ∪ prime_agent_sensitive 33 | End 34 | 35 | Theorem prime_agent_coarse_eq = CONV_RULE(RAND_CONV EVAL) prime_agent_coarse_def 36 | 37 | Definition prime_agent_fine_def: 38 | prime_agent_fine = IMAGE (UNCURRY(++)) (prime_agent_coarse × {"H"; "C"}) DIFF {"AC"; "IC"} 39 | End 40 | 41 | Theorem prime_agent_fine_eq = CONV_RULE(RAND_CONV EVAL) prime_agent_fine_def 42 | 43 | Definition prime_world_def: 44 | prime_world = IMAGE (λ(x,y,z). x ++ y++ z) (prime_env × prime_agent_sensitive × {"H"; "C"}) 45 | End 46 | 47 | Theorem prime_world_eq = CONV_RULE(RAND_CONV EVAL) prime_world_def 48 | 49 | Definition prime_cf_def: 50 | prime_cf = mk_cf <| 51 | world := prime_world; 52 | agent := prime_agent_fine; 53 | env := prime_env; 54 | eval := λa e. e ++ (if e = TAKE 1 a then "A" else 55 | if TAKE 1 a ∈ {"P"; "N"} then "I" 56 | else TAKE 1 a) ++ (DROP 1 a) |> 57 | End 58 | 59 | Theorem wf_prime_cf[simp]: 60 | wf prime_cf 61 | Proof 62 | EVAL_TAC \\ rw[] \\ EVAL_TAC \\ pop_assum mp_tac \\ EVAL_TAC 63 | QED 64 | 65 | Definition prime_world_coarse_def: 66 | prime_world_coarse = IMAGE (TAKE 2) prime_world 67 | End 68 | 69 | Theorem prime_world_coarse_eq = CONV_RULE(RAND_CONV EVAL) prime_world_coarse_def 70 | 71 | Theorem move_fn_prime_cf_matrix: 72 | cf_matrix (move_fn (TAKE 2) prime_world_coarse prime_cf) = 73 | (* N *) (* P *) 74 | (* AH *) [["NA"; "PA"]; 75 | (* IH *) ["NI"; "PI"]; 76 | (* NC *) ["NA"; "PI"]; 77 | (* NH *) ["NA"; "PI"]; 78 | (* PC *) ["NI"; "PA"]; 79 | (* PH *) ["NI"; "PA"]] 80 | Proof 81 | simp[cf_matrix_def] 82 | \\ simp[EVAL``prime_cf.env``, EVAL``prime_cf.agent``] 83 | \\ qsort_set_to_list_tac 84 | \\ EVAL_TAC 85 | QED 86 | 87 | Theorem biextensional_collapse_move_fn_prime_cf_matrix: 88 | cf_matrix (biextensional_collapse (move_fn (TAKE 2) prime_world_coarse prime_cf)) = 89 | (* N *) (* P *) 90 | (* A *) [["NA"; "PA"]; 91 | (* I *) ["NI"; "PI"]; 92 | (* N *) ["NA"; "PI"]; 93 | (* P *) ["NI"; "PA"]] 94 | Proof 95 | rw[biextensional_collapse_def] 96 | \\ simp[EVAL``prime_cf.env``, EVAL``prime_cf.agent``] 97 | \\ qmatch_goalsub_abbrev_tac`min_elt _ s` 98 | \\ `s = { "PH"; "PC"}` 99 | by ( 100 | simp[Abbr`s`, SET_EQ_SUBSET, SUBSET_DEF] \\ rw[] 101 | \\ TRY(pop_assum mp_tac) \\ EVAL_TAC \\ srw_tac[DNF_ss][] ) 102 | \\ `FINITE s ∧ s ≠ ∅` by simp[] 103 | \\ simp[rep_HD_QSORT_SET_TO_LIST] 104 | \\ rpt(pop_assum kall_tac) 105 | \\ qmatch_goalsub_abbrev_tac`min_elt _ s` 106 | \\ `s = { "PH"; "PC"}` 107 | by ( 108 | simp[Abbr`s`, SET_EQ_SUBSET, SUBSET_DEF] \\ rw[] 109 | \\ TRY(pop_assum mp_tac) \\ EVAL_TAC \\ srw_tac[DNF_ss][] ) 110 | \\ `FINITE s ∧ s ≠ ∅` by simp[] 111 | \\ simp[rep_HD_QSORT_SET_TO_LIST] 112 | \\ rpt(pop_assum kall_tac) 113 | \\ qmatch_goalsub_abbrev_tac`min_elt _ s` 114 | \\ `s = { "NH"; "NC"}` 115 | by ( 116 | simp[Abbr`s`, SET_EQ_SUBSET, SUBSET_DEF] \\ rw[] 117 | \\ TRY(pop_assum mp_tac) \\ EVAL_TAC \\ srw_tac[DNF_ss][] ) 118 | \\ `FINITE s ∧ s ≠ ∅` by simp[] 119 | \\ simp[rep_HD_QSORT_SET_TO_LIST] 120 | \\ rpt(pop_assum kall_tac) 121 | \\ qmatch_goalsub_abbrev_tac`min_elt _ s` 122 | \\ `s = { "NH"; "NC"}` 123 | by ( 124 | simp[Abbr`s`, SET_EQ_SUBSET, SUBSET_DEF] \\ rw[] 125 | \\ TRY(pop_assum mp_tac) \\ EVAL_TAC \\ srw_tac[DNF_ss][] ) 126 | \\ `FINITE s ∧ s ≠ ∅` by simp[] 127 | \\ simp[rep_HD_QSORT_SET_TO_LIST] 128 | \\ rpt(pop_assum kall_tac) 129 | \\ qmatch_goalsub_abbrev_tac`min_elt _ s` 130 | \\ `s = { "AH" }` 131 | by ( 132 | simp[Abbr`s`, SET_EQ_SUBSET, SUBSET_DEF] \\ rw[] 133 | \\ TRY(pop_assum mp_tac) \\ EVAL_TAC \\ srw_tac[DNF_ss][] ) 134 | \\ simp[] 135 | \\ rpt(pop_assum kall_tac) 136 | \\ qmatch_goalsub_abbrev_tac`min_elt _ s` 137 | \\ `s = { "IH" }` 138 | by ( 139 | simp[Abbr`s`, SET_EQ_SUBSET, SUBSET_DEF] \\ rw[] 140 | \\ TRY(pop_assum mp_tac) \\ EVAL_TAC \\ srw_tac[DNF_ss][] ) 141 | \\ simp[] 142 | \\ rpt(pop_assum kall_tac) 143 | \\ qmatch_goalsub_abbrev_tac`min_elt _ s` 144 | \\ `s = { "P" }` 145 | by ( 146 | simp[Abbr`s`, SET_EQ_SUBSET, SUBSET_DEF] \\ rw[] 147 | \\ TRY(pop_assum mp_tac) \\ EVAL_TAC \\ srw_tac[DNF_ss][] ) 148 | \\ simp[] 149 | \\ rpt(pop_assum kall_tac) 150 | \\ qmatch_goalsub_abbrev_tac`min_elt _ s` 151 | \\ `s = { "N" }` 152 | by ( 153 | simp[Abbr`s`, SET_EQ_SUBSET, SUBSET_DEF] \\ rw[] 154 | \\ TRY(pop_assum mp_tac) \\ EVAL_TAC \\ srw_tac[DNF_ss][] ) 155 | \\ simp[] 156 | \\ rpt(pop_assum kall_tac) 157 | \\ qsort_set_to_list_tac 158 | \\ CONV_TAC(PATH_CONV"lrrrrl"EVAL) 159 | \\ rw[cf_matrix_def] 160 | \\ qsort_set_to_list_tac 161 | \\ EVAL_TAC 162 | QED 163 | 164 | Theorem prime_cf_eval: 165 | prime_cf.eval a e = 166 | if a ∈ prime_cf.agent ∧ e ∈ prime_cf.env then 167 | e ++ (if e = TAKE 1 a then "A" else if TAKE 1 a ∈ {"P"; "N"} then "I" 168 | else TAKE 1 a) ++ DROP 1 a 169 | else ARB 170 | Proof 171 | rw[prime_cf_def, mk_cf_def] 172 | QED 173 | 174 | Definition prime_outcomes_def: 175 | prime_outcomes w = { x | HD x = #"P" ∧ x ∈ w } 176 | End 177 | 178 | Theorem prime_obs_coarse: 179 | prime_outcomes prime_world_coarse ∈ 180 | obs (move_fn (TAKE 2) prime_world_coarse prime_cf) 181 | Proof 182 | rw[obs_def, prime_outcomes_def, Once prime_world_coarse_def] 183 | >- rw[prime_world_coarse_def, SUBSET_DEF] 184 | \\ rw[ifs_def, PULL_EXISTS] 185 | \\ qmatch_goalsub_abbrev_tac`c.eval` 186 | \\ qexists_tac`if HD a0 = #"P" ∨ HD a0 = #"A" then 187 | if HD a1 = #"P" ∨ HD a1 = #"I" then 188 | "PH" else "AH" 189 | else 190 | if HD a1 = #"P" ∨ HD a1 = #"I" then 191 | "IH" else "NH"` 192 | \\ qmatch_goalsub_abbrev_tac`a ∈ _` 193 | \\ conj_asm1_tac 194 | >- rw[Abbr`a`, prime_cf_def, prime_agent_fine_eq] 195 | \\ simp[Abbr`c`, move_fn_def] 196 | \\ simp[prime_cf_eval] 197 | \\ pop_assum kall_tac 198 | \\ unabbrev_all_tac 199 | \\ gs[prime_cf_def] 200 | \\ rpt (pop_assum mp_tac) 201 | \\ simp[prime_env_def, prime_agent_fine_eq] 202 | \\ strip_tac \\ simp[] \\ strip_tac \\ simp[] 203 | \\ rpt strip_tac \\ simp[] \\ gvs[] 204 | \\ rpt(pop_assum mp_tac) 205 | \\ dsimp[prime_world_eq] 206 | QED 207 | 208 | Theorem prime_not_obs_fine: 209 | prime_outcomes prime_world ∉ obs prime_cf 210 | Proof 211 | rw[obs_def, prime_outcomes_def] 212 | \\ CCONTR_TAC \\ fs[] 213 | \\ pop_assum mp_tac \\ simp[] 214 | \\ qexists_tac`"PC"` 215 | \\ qexists_tac`"NC"` 216 | \\ conj_tac >- rw[prime_cf_def, prime_agent_fine_eq] 217 | \\ rw[ifs_def] 218 | \\ CCONTR_TAC \\ fs[] 219 | \\ pop_assum mp_tac \\ simp[] 220 | \\ qexists_tac`if HD a = #"P" then "N" else "P"` 221 | \\ conj_asm1_tac >- rw[prime_cf_def, prime_env_def] 222 | \\ simp[prime_cf_eval] 223 | \\ qpat_x_assum`a ∈ _`mp_tac 224 | \\ simp[prime_cf_def, prime_agent_fine_eq] 225 | \\ strip_tac \\ simp[] 226 | \\ EVAL_TAC 227 | QED 228 | 229 | Theorem prime_cf_in_chu_objects[simp]: 230 | prime_cf ∈ chu_objects prime_world 231 | Proof 232 | rw[prime_cf_def, in_chu_objects] 233 | QED 234 | 235 | Theorem image_prime_cf: 236 | image prime_cf = prime_world 237 | Proof 238 | `prime_cf.world = prime_world` by rw[prime_cf_def] 239 | \\ rw[image_def, SET_EQ_SUBSET, SUBSET_DEF] 240 | >- metis_tac[wf_prime_cf, wf_def] 241 | \\ simp[prime_cf_eval] 242 | \\ pop_assum mp_tac 243 | \\ EVAL_TAC \\ simp[] 244 | \\ strip_tac 245 | \\ csimp[] \\ dsimp[] 246 | QED 247 | 248 | Theorem prime_coarse_product: 249 | move_fn (TAKE 2) prime_world_coarse prime_cf ≃ 250 | cfbot prime_world_coarse {x | HD x = #"P" ∧ x ∈ prime_world_coarse } && 251 | cfbot prime_world_coarse {x | HD x = #"N" ∧ x ∈ prime_world_coarse } 252 | -: prime_world_coarse 253 | Proof 254 | rw[homotopy_equiv_def] 255 | \\ qmatch_goalsub_abbrev_tac`_ :- pc → c1 && c2 -: _` 256 | \\ qexists_tac`mk_chu_morphism pc (c1 && c2) 257 | <| map_agent := λa. if HD a = #"A" then encode_pair ("PA", "NA") 258 | else if HD a = #"I" then encode_pair ("PI", "NI") 259 | else if HD a = #"P" then encode_pair ("PA", "NI") 260 | else encode_pair ("PI", "NA"); 261 | map_env := λe. sum_CASE (decode_sum e) (K"P") (K"N") |>` 262 | \\ qmatch_goalsub_abbrev_tac`_ o f -: _` 263 | \\ qexists_tac`mk_chu_morphism (c1 && c2) pc 264 | <| map_agent := λa. 265 | if a = encode_pair ("PA", "NA") then "AH" 266 | else if a = encode_pair ("PI", "NI") then "IH" 267 | else if a = encode_pair ("PA", "NI") then "PH" 268 | else "NH"; 269 | map_env := λe. 270 | encode_sum (if e = "P" then (INL "") else (INR "")) |>` 271 | \\ qmatch_goalsub_abbrev_tac`g o f -: _` 272 | \\ `FINITE prime_world_coarse` by simp[prime_world_coarse_eq] 273 | \\ `pc ∈ chu_objects prime_world_coarse` 274 | by ( 275 | simp[Abbr`pc`] 276 | \\ irule move_fn_in_chu_objects 277 | \\ simp[] 278 | \\ qexists_tac`prime_world` 279 | \\ simp[SUBSET_DEF, PULL_EXISTS] 280 | \\ rw[prime_world_eq, prime_world_coarse_eq] \\ rw[]) 281 | \\ `c1 && c2 ∈ chu_objects prime_world_coarse` 282 | by ( 283 | simp[Abbr`c1`, Abbr`c2`] 284 | \\ irule prod_in_chu_objects 285 | \\ simp[SUBSET_DEF] ) 286 | \\ conj_asm1_tac 287 | >- ( 288 | simp[maps_to_in_chu, GSYM CONJ_ASSOC, Abbr`f`] 289 | \\ simp[is_chu_morphism_def, mk_chu_morphism_def] 290 | \\ simp[restrict_def] 291 | \\ conj_asm1_tac 292 | >- ( 293 | simp[prod_def, PULL_EXISTS] 294 | \\ simp[Abbr`c1`, Abbr`c2`, PULL_EXISTS, cfbot_def] 295 | \\ simp[Abbr`pc`, prime_cf_def, prime_env_def] 296 | \\ rw[] \\ rw[] ) 297 | \\ conj_asm1_tac 298 | >- ( 299 | simp[prod_def, EXISTS_PROD] 300 | \\ simp[Abbr`pc`, prime_cf_def, prime_agent_fine_eq] 301 | \\ simp[Abbr`c1`, Abbr`c2`, cfbot_def, prime_world_coarse_eq] 302 | \\ rw[] \\ rw[]) 303 | \\ simp[prod_eval] 304 | \\ fs[Abbr`pc`] 305 | \\ simp[prime_cf_eval] 306 | \\ simp[prod_def, PULL_EXISTS] 307 | \\ dsimp[sum_eval_def] 308 | \\ simp[Abbr`c1`, Abbr`c2`, cfbot_def, cf1_def, mk_cf_def, prime_world_coarse_eq] 309 | \\ simp[prime_cf_def, prime_agent_fine_eq] 310 | \\ conj_tac \\ rpt strip_tac \\ simp[]) 311 | \\ conj_asm1_tac 312 | >- ( 313 | simp[maps_to_in_chu, Abbr`g`] 314 | \\ simp[is_chu_morphism_def, mk_chu_morphism_def] 315 | \\ simp[restrict_def] 316 | \\ conj_asm1_tac 317 | >- ( 318 | simp[prod_def, EXISTS_PROD] 319 | \\ simp[Abbr`pc`, prime_cf_def, prime_agent_fine_eq] 320 | \\ simp[Abbr`c1`, Abbr`c2`, cfbot_def, prime_world_coarse_eq]) 321 | \\ conj_asm1_tac 322 | >- ( 323 | simp[prod_def, PULL_EXISTS, EXISTS_PROD] 324 | \\ simp[Abbr`c1`, Abbr`c2`, PULL_EXISTS, cfbot_def] 325 | \\ simp[Abbr`pc`, prime_cf_def, prime_env_def, prime_agent_fine_eq] 326 | \\ rw[] \\ rw[] ) 327 | \\ simp[prod_eval] 328 | \\ simp[Abbr`pc`] \\ fs[] 329 | \\ simp[prime_cf_eval] 330 | \\ simp[prod_def, PULL_EXISTS, EXISTS_PROD] 331 | \\ simp[prime_cf_def, prime_env_def] 332 | \\ dsimp[sum_eval_def] 333 | \\ simp[Abbr`c1`, Abbr`c2`, cfbot_def, cf1_def, mk_cf_def, prime_world_coarse_eq] 334 | \\ conj_tac \\ rpt strip_tac \\ gs[]) 335 | \\ qpat_assum`f :- _ → _ -: _`(mp_then Any mp_tac compose_in_chu) 336 | \\ disch_then(qpat_assum`g :- _ → _ -: _`o mp_then Any strip_assume_tac) 337 | \\ qpat_assum`g :- _ → _ -: _`(mp_then Any mp_tac compose_in_chu) 338 | \\ disch_then(qpat_assum`f :- _ → _ -: _`o mp_then Any strip_assume_tac) 339 | \\ simp[homotopic_id_map_env_id] 340 | \\ simp[restrict_def] 341 | \\ fs[Abbr`f`,Abbr`g`,mk_chu_morphism_def] 342 | \\ simp[restrict_def] 343 | \\ simp[Abbr`pc`] 344 | \\ simp[Once prime_cf_def] 345 | \\ dsimp[prime_env_def] 346 | \\ conj_tac 347 | >- ( simp[prod_def] \\ simp[Abbr`c1`, Abbr`c2`, cfbot_def] ) 348 | \\ dsimp[Once prod_def, PULL_EXISTS] 349 | \\ simp[prime_cf_def, prime_env_def] 350 | \\ simp[Abbr`c1`, Abbr`c2`, cfbot_def] 351 | QED 352 | 353 | val _ = export_theory(); 354 | -------------------------------------------------------------------------------- /ex5Script.sml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright 2021 DeepMind Technologies Limited. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | https://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | *) 16 | 17 | open HolKernel boolLib bossLib Parse 18 | pred_setTheory categoryTheory 19 | cf0Theory cf1Theory cf2Theory cf5Theory 20 | 21 | val _ = new_theory"ex5"; 22 | 23 | Definition team_def: 24 | team = cfbot {"x";"y"} {"x";"y"} 25 | End 26 | 27 | Definition alice_def: 28 | alice = mk_cf <| world := {"x"; "y"}; 29 | agent := {"x"; "y"; "b"}; 30 | env := {"x"; "y"}; 31 | eval := λa e. if a = "b" then e else a |> 32 | End 33 | 34 | Theorem team_in_chu_objects[simp]: 35 | team ∈ chu_objects {"x";"y"} 36 | Proof 37 | rw[team_def] 38 | QED 39 | 40 | Theorem alice_in_chu_objects[simp]: 41 | alice ∈ chu_objects {"x";"y"} 42 | Proof 43 | rw[alice_def, in_chu_objects, finite_cf_def] 44 | \\ rw[image_def, SUBSET_DEF] 45 | QED 46 | 47 | Theorem alice_subagent_team: 48 | alice ◁ team -: {"x";"y"} 49 | Proof 50 | rw[subagent_covering] 51 | \\ rw[covering_subagent_def] 52 | \\ qexists_tac`""` 53 | \\ simp[Once team_def, cfbot_def] 54 | \\ qexists_tac`mk_chu_morphism alice team <| map_agent := λa. if a = "b" then e else a; 55 | map_env := K e |>` 56 | \\ reverse conj_tac >- simp[mk_chu_morphism_def, restrict_def, team_def, cfbot_def] 57 | \\ simp[maps_to_in_chu] 58 | \\ simp[is_chu_morphism_def, mk_chu_morphism_def] 59 | \\ simp[restrict_def] 60 | \\ `team.agent = alice.env` by simp[team_def, alice_def, cfbot_def] 61 | \\ `alice.agent = "b" INSERT alice.env` by ( 62 | simp[alice_def] \\ simp[EXTENSION] \\ metis_tac[] ) 63 | \\ simp[] 64 | \\ conj_tac >- metis_tac[] 65 | \\ qpat_x_assum`e ∈ _`mp_tac 66 | \\ EVAL_TAC 67 | \\ rw[] 68 | QED 69 | 70 | Theorem team_subagent_alice: 71 | team ◁ alice -: {"x";"y"} 72 | Proof 73 | rw[subagent_covering, covering_subagent_def] 74 | \\ pop_assum mp_tac 75 | \\ rw[Once team_def, cfbot_def] 76 | \\ qexists_tac`"x"` 77 | \\ simp[Once alice_def] 78 | \\ qexists_tac`mk_chu_morphism team alice <| map_agent := I; map_env := K "" |>` 79 | \\ simp[maps_to_in_chu, is_chu_morphism_def, mk_chu_morphism_def] 80 | \\ simp[restrict_def] 81 | \\ EVAL_TAC \\ rw[] 82 | QED 83 | 84 | Theorem nontrivial_mutual_subagents: 85 | mutual_subagents {"x";"y"} alice team 86 | Proof 87 | metis_tac[mutual_subagents_def, alice_subagent_team, team_subagent_alice] 88 | QED 89 | 90 | val _ = export_theory(); 91 | -------------------------------------------------------------------------------- /ex6Script.sml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright 2021 DeepMind Technologies Limited. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | https://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | *) 16 | 17 | open HolKernel boolLib bossLib Parse dep_rewrite 18 | pairTheory pred_setTheory helperSetTheory rich_listTheory categoryTheory 19 | cf0Theory cf1Theory cf2Theory cf4Theory cf5Theory cf6Theory 20 | 21 | val _ = new_theory"ex6"; 22 | 23 | Definition guests_def: 24 | guests = {"J";"K";"L"} 25 | End 26 | 27 | Theorem FINITE_guests[simp]: 28 | FINITE guests 29 | Proof 30 | rw[guests_def] 31 | QED 32 | 33 | Definition votes_world_def: 34 | votes_world = IMAGE encode_set (POW guests) 35 | End 36 | 37 | Theorem FINITE_votes_world[simp]: 38 | FINITE votes_world 39 | Proof 40 | rw[votes_world_def] 41 | QED 42 | 43 | Definition guest_def: 44 | guest x = mk_cf <| world := votes_world; 45 | agent := IMAGE encode_set (POW {x}); 46 | env := IMAGE encode_set (POW (guests DELETE x)); 47 | eval := λa e. encode_set (decode_set a ∪ decode_set e) |> 48 | End 49 | 50 | Definition jack_def: 51 | jack = guest "J" 52 | End 53 | 54 | Definition kate_def: 55 | kate = guest "K" 56 | End 57 | 58 | Definition luke_def: 59 | luke = guest "L" 60 | End 61 | 62 | Theorem guest_in_chu_objects[simp]: 63 | x ∈ guests ⇒ 64 | guest x ∈ chu_objects votes_world 65 | Proof 66 | rw[guest_def, in_chu_objects, finite_cf_def] 67 | \\ rw[image_def, SUBSET_DEF] 68 | \\ DEP_REWRITE_TAC[decode_encode_set] 69 | \\ fs[IN_POW] 70 | \\ conj_tac >- metis_tac[SUBSET_FINITE, FINITE_DELETE, FINITE_SING, FINITE_guests] 71 | \\ simp[votes_world_def] 72 | \\ qmatch_goalsub_abbrev_tac`encode_set s` 73 | \\ qexists_tac`s` \\ simp[Abbr`s`, IN_POW] 74 | \\ fs[SUBSET_DEF] 75 | QED 76 | 77 | Theorem guest_world[simp]: 78 | (guest x).world = votes_world 79 | Proof 80 | rw[guest_def] 81 | QED 82 | 83 | Theorem guest_eval: 84 | (guest x).eval a e = 85 | if a ∈ (guest x).agent ∧ e ∈ (guest x).env then 86 | encode_set (decode_set a ∪ decode_set e) 87 | else ARB 88 | Proof 89 | rw[guest_def, mk_cf_def] 90 | QED 91 | 92 | Definition mor1_def: 93 | mor1 x y = mk_chu_morphism (guest x) (swap (guest y)) 94 | <| map_agent := λa. if a = encode_set ∅ then a else encode_set {x}; 95 | map_env := λe. if e = encode_set ∅ then e else encode_set {y} |> 96 | End 97 | 98 | Definition mor2_def: 99 | mor2 x y = mk_chu_morphism (guest x) (swap (guest y)) 100 | <| map_agent := λa. if a = encode_set ∅ 101 | then encode_set (guests DIFF {x; y}) 102 | else encode_set (guests DIFF {y}); 103 | map_env := λe. if e = encode_set ∅ 104 | then encode_set (guests DIFF {x; y}) 105 | else encode_set (guests DIFF {x}) |> 106 | End 107 | 108 | Theorem mor1_dom_cod[simp]: 109 | (mor1 x y).dom = guest x ∧ 110 | (mor1 x y).cod = swap(guest y) 111 | Proof 112 | rw[mor1_def] 113 | QED 114 | 115 | Theorem mor2_dom_cod[simp]: 116 | (mor2 x y).dom = guest x ∧ 117 | (mor2 x y).cod = swap(guest y) 118 | Proof 119 | rw[mor2_def] 120 | QED 121 | 122 | Theorem mor1_maps_to: 123 | x ∈ guests ∧ y ∈ guests ∧ x ≠ y ⇒ 124 | mor1 x y :- guest x → swap (guest y) -: chu votes_world 125 | Proof 126 | rw[maps_to_in_chu, mor1_def] 127 | \\ simp[mk_chu_morphism_def, is_chu_morphism_def] 128 | \\ simp[restrict_def] 129 | \\ simp[guest_def, PULL_EXISTS] 130 | \\ simp[mk_cf_def] 131 | \\ dsimp[POW_EQNS] 132 | \\ qexistsl_tac[`{y}`,`{}`,`{x}`,`{}`] 133 | \\ simp[] 134 | \\ conj_asm1_tac >- simp[IN_POW] 135 | \\ conj_asm1_tac >- simp[IN_POW] 136 | \\ reverse IF_CASES_TAC >- metis_tac[] 137 | \\ reverse IF_CASES_TAC >- metis_tac[] 138 | \\ reverse IF_CASES_TAC >- metis_tac[IN_POW, EMPTY_SUBSET] 139 | \\ reverse IF_CASES_TAC >- metis_tac[IN_POW, EMPTY_SUBSET] 140 | \\ simp[UNION_COMM] 141 | QED 142 | 143 | Theorem mor2_maps_to: 144 | x ∈ guests ∧ y ∈ guests ∧ x ≠ y ⇒ 145 | mor2 x y :- guest x → swap (guest y) -: chu votes_world 146 | Proof 147 | rw[maps_to_in_chu, mor2_def] 148 | \\ simp[mk_chu_morphism_def, is_chu_morphism_def] 149 | \\ simp[restrict_def] 150 | \\ simp[guest_def, PULL_EXISTS] 151 | \\ simp[mk_cf_def] 152 | \\ dsimp[POW_EQNS] 153 | \\ qexistsl_tac[`guests DIFF {x}`,`guests DIFF {x;y}`, 154 | `guests DIFF {y}`,`guests DIFF {x;y}`] 155 | \\ simp[] 156 | \\ conj_asm1_tac >- simp[IN_POW, SUBSET_DEF] 157 | \\ conj_asm1_tac >- simp[IN_POW, SUBSET_DEF] 158 | \\ reverse IF_CASES_TAC >- metis_tac[] 159 | \\ reverse IF_CASES_TAC >- metis_tac[] 160 | \\ reverse IF_CASES_TAC >- metis_tac[] 161 | \\ reverse IF_CASES_TAC >- metis_tac[] 162 | \\ simp[] 163 | \\ simp[Once EXTENSION, GSYM CONJ_ASSOC] 164 | \\ conj_tac >- metis_tac[] 165 | \\ simp[Once EXTENSION] 166 | \\ conj_tac >- metis_tac[] 167 | \\ simp[Once EXTENSION] 168 | \\ metis_tac[] 169 | QED 170 | 171 | Theorem maps_to_swap_guest: 172 | x ∈ guests ∧ y ∈ guests ∧ x ≠ y ⇒ 173 | (m :- guest x → swap (guest y) -: chu votes_world ⇔ 174 | m ∈ {mor1 x y; mor2 x y}) 175 | Proof 176 | strip_tac 177 | \\ simp[] 178 | \\ reverse eq_tac >- metis_tac[mor1_maps_to, mor2_maps_to] 179 | \\ simp[maps_to_in_chu] 180 | \\ simp[is_chu_morphism_def] 181 | \\ strip_tac 182 | \\ simp[morphism_component_equality] 183 | \\ fs[guest_def, PULL_EXISTS] 184 | \\ ntac 2 (pop_assum kall_tac) 185 | \\ fs[mk_cf_def] 186 | \\ fs[POW_EQNS] 187 | \\ pop_assum mp_tac \\ dsimp[] 188 | \\ ntac 2 (pop_assum mp_tac) \\ dsimp[] 189 | \\ rpt gen_tac 190 | \\ ntac 2 strip_tac 191 | \\ DEP_REWRITE_TAC[decode_encode_set] 192 | \\ fs[IN_POW] 193 | \\ conj_asm1_tac 194 | >- metis_tac [IN_POW, SUBSET_FINITE, FINITE_DELETE, FINITE_guests] 195 | \\ simp[] 196 | \\ strip_tac 197 | \\ rpt BasicProvers.VAR_EQ_TAC \\ fs[] 198 | \\ fs[extensional_def] 199 | \\ simp[chu_morphism_map_component_equality] 200 | \\ simp[FUN_EQ_THM, PULL_FORALL] 201 | \\ simp[mor1_def, mor2_def, mk_chu_morphism_def] 202 | \\ simp[guest_def, restrict_def, PULL_EXISTS, POW_EQNS] 203 | \\ dsimp[] 204 | \\ qmatch_assum_rename_tac`z ⊆ _` 205 | \\ Cases_on`z = {}` \\ fs[] 206 | >- ( disj1_tac \\ rw[] \\ metis_tac[] ) 207 | \\ `z = guests DIFF {x; y}` 208 | by ( 209 | fs[SUBSET_DEF, GSYM MEMBER_NOT_EMPTY] 210 | \\ simp[EXTENSION] 211 | \\ gvs[guests_def] 212 | \\ metis_tac[]) 213 | \\ disj2_tac 214 | \\ rw[] \\ rw[] 215 | \\ rw[EXTENSION] 216 | \\ metis_tac[] 217 | QED 218 | 219 | Theorem mor1_neq_mor2: 220 | mor1 x y ≠ mor2 x y 221 | Proof 222 | rw[mor1_def, mor2_def, morphism_component_equality] 223 | \\ rw[chu_morphism_map_component_equality] 224 | \\ fs[mk_chu_morphism_def] 225 | \\ fs[restrict_def] 226 | \\ fs[FUN_EQ_THM] 227 | \\ dsimp[guest_def, POW_EQNS] 228 | \\ qexists_tac`encode_set ∅` 229 | \\ simp[] 230 | \\ simp[guests_def] 231 | \\ rw[] 232 | QED 233 | 234 | Theorem tensor_guests_iso: 235 | x ∈ guests ∧ y ∈ guests ∧ x ≠ y ⇒ 236 | tensor (guest x) (guest y) ≅ 237 | (swap (guest (CHOICE (guests DIFF {x;y})))) -: chu votes_world 238 | Proof 239 | rw[iso_objs_thm] 240 | \\ qmatch_goalsub_abbrev_tac`swap (guest z)` 241 | \\ qexists_tac`mk_chu_morphism (tensor (guest x) (guest y)) (swap (guest z)) 242 | <| map_agent := λp. let (a,b) = decode_pair p in 243 | encode_set (decode_set a ∪ decode_set b); 244 | map_env := λe. 245 | encode_morphism 246 | ((if e = encode_set ∅ then mor1 else mor2) x y )|>` 247 | \\ `z ∈ guests ∧ z ≠ x ∧ z ≠ y` 248 | by ( 249 | simp[Abbr`z`] 250 | \\ qmatch_goalsub_abbrev_tac`CHOICE s` 251 | \\ `CHOICE s ∈ s` 252 | by( 253 | irule CHOICE_DEF 254 | \\ simp[Abbr`s`, GSYM MEMBER_NOT_EMPTY] 255 | \\ gs[guests_def] 256 | \\ dsimp[]) 257 | \\ fs[Abbr`s`]) 258 | \\ `guests = {x;y;z}` 259 | by ( fs[guests_def] \\ gvs[] 260 | \\ rw[EXTENSION] \\ metis_tac[]) 261 | \\ conj_asm1_tac 262 | >- ( 263 | simp[maps_to_in_chu] 264 | \\ simp[is_chu_morphism_def, mk_chu_morphism_def] 265 | \\ simp[restrict_def] 266 | \\ conj_asm1_tac 267 | >- ( 268 | dsimp[tensor_def, hom_def] \\ rw[] 269 | \\ metis_tac[mor1_maps_to, mor2_maps_to] ) 270 | \\ conj_asm1_tac 271 | >- ( 272 | simp[tensor_def, PULL_EXISTS, EXISTS_PROD] 273 | \\ simp[guest_def, PULL_EXISTS] 274 | \\ dsimp[POW_EQNS] 275 | \\ qexists_tac`{x}∪{y}` 276 | \\ qexists_tac`{x}` 277 | \\ qexists_tac`{y}` 278 | \\ qexists_tac`{}` \\ simp[] 279 | \\ simp[IN_POW, SUBSET_DEF]) 280 | \\ simp[tensor_eval] 281 | \\ simp[tensor_def, PULL_EXISTS, EXISTS_PROD] 282 | \\ simp[Ntimes guest_def 2, PULL_EXISTS] 283 | \\ rpt gen_tac 284 | \\ DEP_REWRITE_TAC[Q.GEN`w`decode_encode_chu_morphism] 285 | \\ conj_tac >- metis_tac[mor1_maps_to, mor2_maps_to] 286 | \\ simp[guest_eval] 287 | \\ simp[guest_def, PULL_EXISTS] 288 | \\ simp[DELETE_INSERT] 289 | \\ dsimp[POW_EQNS] 290 | \\ simp[mor1_def, mor2_def, mk_chu_morphism_def, restrict_def, guest_def] 291 | \\ dsimp[POW_EQNS] 292 | \\ rw[] \\ rw[] \\ gs[] 293 | \\ fs[EXTENSION] \\ metis_tac[] ) 294 | \\ simp[chu_iso_bij] 295 | \\ fs[maps_to_in_chu] 296 | \\ fs[is_chu_morphism_def, mk_chu_morphism_def] 297 | \\ fs[restrict_def] 298 | \\ simp[BIJ_DEF, INJ_DEF, SURJ_DEF] 299 | \\ simp[tensor_def, PULL_EXISTS, EXISTS_PROD] 300 | \\ simp[Ntimes guest_def 9, hom_def, PULL_EXISTS] 301 | \\ qpat_assum`_ = guests`(SUBST1_TAC o SYM) 302 | \\ simp[DELETE_INSERT] 303 | \\ dsimp[POW_EQNS] 304 | \\ rpt disj1_tac 305 | \\ conj_tac >- (simp[EXTENSION] \\ metis_tac[]) 306 | \\ conj_tac >- metis_tac[decode_encode_chu_morphism, 307 | mor1_neq_mor2, mor1_maps_to, mor2_maps_to] 308 | \\ rpt strip_tac 309 | \\ drule_then (drule_then (drule_then 310 | (drule_then mp_tac o 311 | Q.GEN`m` o #1 o EQ_IMP_RULE o SPEC_ALL))) maps_to_swap_guest 312 | \\ dsimp[] 313 | \\ simp[guest_def, PULL_EXISTS] 314 | \\ dsimp[POW_EQNS] 315 | QED 316 | 317 | Theorem tensor_jack_kate: 318 | tensor jack kate ≅ swap luke -: chu votes_world 319 | Proof 320 | rw[jack_def, kate_def, luke_def] 321 | \\ `"L" = CHOICE (guests DIFF {"J";"K"})` 322 | by simp[guests_def] 323 | \\ pop_assum SUBST1_TAC 324 | \\ irule tensor_guests_iso 325 | \\ simp[guests_def] 326 | QED 327 | 328 | Definition majority_def: 329 | majority s = if CARD guests ≤ 2 * CARD (decode_set s) then "Y" else "N" 330 | End 331 | 332 | Definition party_world_def: 333 | party_world = {"Y";"N"} 334 | End 335 | 336 | Theorem FINITE_party_world[simp]: 337 | FINITE party_world 338 | Proof 339 | rw[party_world_def] 340 | QED 341 | 342 | Theorem move_fn_majority_in_chu_objects[simp]: 343 | x ∈ guests ⇒ 344 | move_fn majority party_world (guest x) ∈ chu_objects party_world 345 | Proof 346 | strip_tac 347 | \\ irule move_fn_in_chu_objects 348 | \\ rw[] 349 | \\ qexists_tac`votes_world` 350 | \\ simp[SUBSET_DEF, PULL_EXISTS] 351 | \\ rw[majority_def] 352 | \\ rw[party_world_def] 353 | QED 354 | 355 | Definition guest_party_def: 356 | guest_party = mk_cf <| world := party_world; 357 | agent := {"";" "}; 358 | env := {"";" ";" "}; 359 | eval := λa e. if (LENGTH a + LENGTH e < 2) then "N" else "Y" |> 360 | End 361 | 362 | Theorem guest_party_eval: 363 | guest_party.eval a e = 364 | if a ∈ guest_party.agent ∧ e ∈ guest_party.env then 365 | if (LENGTH a + LENGTH e < 2) then "N" else "Y" 366 | else ARB 367 | Proof 368 | rw[guest_party_def, mk_cf_def] 369 | QED 370 | 371 | Theorem guest_party_world[simp]: 372 | guest_party.world = party_world 373 | Proof 374 | rw[guest_party_def] 375 | QED 376 | 377 | Theorem guest_party_in_chu_objects[simp]: 378 | guest_party ∈ chu_objects party_world 379 | Proof 380 | rw[in_chu_objects, guest_party_def, finite_cf_def] 381 | \\ rw[image_def, SUBSET_DEF] 382 | \\ rw[party_world_def] 383 | QED 384 | 385 | Theorem CARD_guests: 386 | CARD guests = 3 387 | Proof 388 | rw[guests_def] 389 | QED 390 | 391 | Theorem move_fn_majority_guest_equiv_party: 392 | x ∈ guests ⇒ 393 | move_fn majority party_world (guest x) ≃ guest_party -: party_world 394 | Proof 395 | rw[homotopy_equiv_def] 396 | \\ qmatch_goalsub_abbrev_tac`_ :- px → gp -: _` 397 | \\ qexists_tac`mk_chu_morphism px gp 398 | <| map_agent := flip REPLICATE #" " o CARD o decode_set; 399 | map_env := λe. 400 | encode_set (@s. s ⊆ guests DELETE x ∧ CARD s = LENGTH e) |>` 401 | \\ qmatch_goalsub_abbrev_tac`_ o f -: _` 402 | \\ qexists_tac`mk_chu_morphism gp px 403 | <| map_agent := λa. encode_set (if a = "" then ∅ else {x}); 404 | map_env := flip REPLICATE #" " o CARD o decode_set |>` 405 | \\ qmatch_goalsub_abbrev_tac`g o _ -: _` 406 | \\ conj_asm1_tac 407 | >- ( 408 | simp[maps_to_in_chu, Abbr`px`, Abbr`gp`] 409 | \\ simp[Abbr`f`, is_chu_morphism_def, mk_chu_morphism_def] 410 | \\ simp[restrict_def] 411 | \\ conj_asm1_tac 412 | >- ( 413 | simp[guest_def, IN_POW] 414 | \\ rpt strip_tac 415 | \\ SELECT_ELIM_TAC 416 | \\ reverse conj_tac >- metis_tac[] 417 | \\ qpat_x_assum`x ∈ _`mp_tac 418 | \\ simp [GSYM IN_POW] 419 | \\ simp[guests_def, DELETE_INSERT] 420 | \\ fs[guest_party_def] 421 | \\ strip_tac \\ simp[POW_EQNS] 422 | \\ dsimp[]) 423 | \\ conj_asm1_tac 424 | >- ( 425 | dsimp[guest_def, PULL_EXISTS, POW_EQNS, REPLICATE_compute] 426 | \\ simp[guest_party_def]) 427 | \\ simp[move_fn_def] 428 | \\ simp[guest_eval, guest_party_eval] 429 | \\ rpt gen_tac 430 | \\ strip_tac 431 | \\ SELECT_ELIM_TAC 432 | \\ conj_tac 433 | >- ( 434 | qpat_x_assum`x ∈ _`mp_tac 435 | \\ simp [GSYM IN_POW] 436 | \\ simp[guests_def, DELETE_INSERT] 437 | \\ fs[guest_party_def] 438 | \\ strip_tac \\ dsimp[POW_EQNS]) 439 | \\ rpt strip_tac 440 | \\ simp[majority_def] 441 | \\ DEP_REWRITE_TAC[decode_encode_set] 442 | \\ conj_asm1_tac >- metis_tac[FINITE_guests, FINITE_DELETE, SUBSET_FINITE] 443 | \\ simp[] 444 | \\ conj_asm1_tac >- fs[guest_def, POW_EQNS] 445 | \\ DEP_REWRITE_TAC[CARD_UNION_DISJOINT] 446 | \\ simp[CARD_guests] 447 | \\ conj_tac >- (fs[guest_def, POW_EQNS, SUBSET_DEF] \\ metis_tac[]) 448 | \\ rw[]) 449 | \\ conj_asm1_tac 450 | >- ( 451 | simp[maps_to_in_chu, Abbr`px`, Abbr`gp`] 452 | \\ simp[Abbr`g`, is_chu_morphism_def, mk_chu_morphism_def] 453 | \\ simp[restrict_def] 454 | \\ conj_asm1_tac 455 | >- ( 456 | qpat_x_assum`x ∈ _`mp_tac 457 | \\ simp [guest_def, GSYM IN_POW, PULL_EXISTS] 458 | \\ simp[guests_def, DELETE_INSERT] 459 | \\ rw[POW_EQNS] \\ rw[REPLICATE_compute, guest_party_def]) 460 | \\ conj_asm1_tac 461 | >- rw[guest_def, POW_EQNS] 462 | \\ simp[move_fn_def] 463 | \\ simp[guest_party_eval] 464 | \\ simp[guest_eval] 465 | \\ simp[majority_def, CARD_guests] 466 | \\ rpt gen_tac \\ strip_tac 467 | \\ DEP_REWRITE_TAC[decode_encode_set] 468 | \\ DEP_REWRITE_TAC[CARD_UNION_DISJOINT] 469 | \\ conj_asm1_tac >- ( 470 | fs[guest_def] 471 | \\ fs[IN_POW] 472 | \\ DEP_REWRITE_TAC[decode_encode_set] 473 | \\ conj_asm1_tac 474 | >- metis_tac[decode_encode_set, FINITE_DELETE, 475 | FINITE_guests, SUBSET_FINITE] 476 | \\ rw[] 477 | \\ gs[SUBSET_DEF] 478 | \\ metis_tac[]) 479 | \\ fs[] 480 | \\ Cases_on`a = ""` \\ rw[] 481 | \\ gs[guest_party_def]) 482 | \\ qpat_assum`f :- _ → _ -: _`(mp_then Any mp_tac compose_in_chu) 483 | \\ disch_then(qpat_assum`g :- _ → _ -: _` o mp_then Any strip_assume_tac) 484 | \\ qpat_assum`g :- _ → _ -: _`(mp_then Any mp_tac compose_in_chu) 485 | \\ disch_then(qpat_assum`f :- _ → _ -: _` o mp_then Any strip_assume_tac) 486 | \\ simp[homotopic_id_map_agent_id, Abbr`px`, Abbr`gp`] 487 | \\ simp[restrict_def] 488 | \\ simp[Abbr`g`, Abbr`f`, mk_chu_morphism_def] 489 | \\ simp[restrict_def] 490 | \\ conj_tac 491 | >- ( 492 | simp[Once guest_def, PULL_EXISTS] 493 | \\ dsimp[POW_EQNS] 494 | \\ rw[guest_party_def, REPLICATE_compute] ) 495 | \\ simp[Once guest_party_def] 496 | \\ simp[Once guest_def, POW_EQNS] 497 | \\ dsimp[REPLICATE_compute] 498 | QED 499 | 500 | Theorem move_fn_majority_tensor_guests_equiv_swap_party: 501 | x ∈ guests ∧ y ∈ guests ∧ x ≠ y ⇒ 502 | move_fn majority party_world (tensor (guest x) (guest y)) ≃ swap guest_party 503 | -: party_world 504 | Proof 505 | strip_tac 506 | \\ qmatch_goalsub_abbrev_tac`p (tensor _ _)` 507 | \\ irule homotopy_equiv_trans 508 | \\ qabbrev_tac`z = CHOICE (guests DIFF {x; y})` 509 | \\ qexists_tac`p (swap (guest z))` 510 | \\ conj_tac 511 | >- ( 512 | qunabbrev_tac`p` 513 | \\ irule homotopy_equiv_move_fn 514 | \\ simp[] 515 | \\ qexists_tac`votes_world` 516 | \\ simp[SUBSET_DEF, PULL_EXISTS, majority_def] 517 | \\ rw[party_world_def] 518 | \\ irule iso_homotopy_equiv 519 | \\ qunabbrev_tac`z` 520 | \\ irule tensor_guests_iso 521 | \\ simp[] ) 522 | \\ simp[Abbr`p`, move_fn_swap] 523 | \\ DEP_REWRITE_TAC[homotopy_equiv_swap] 524 | \\ `z ∈ guests` 525 | by ( simp[Abbr`z`] \\ gs[guests_def] ) 526 | \\ simp[move_fn_majority_guest_equiv_party] 527 | QED 528 | 529 | Theorem move_fn_majority_tensor_not_preserved: 530 | x ∈ guests ∧ y ∈ guests ∧ x ≠ y ⇒ 531 | let p = move_fn majority party_world in 532 | ¬ (p (tensor (guest x) (guest y)) ≃ tensor (p (guest x)) (p (guest y)) 533 | -: party_world) 534 | Proof 535 | strip_tac 536 | \\ BasicProvers.LET_ELIM_TAC 537 | \\ strip_tac 538 | \\ `swap guest_party ≃ tensor guest_party guest_party -: party_world` 539 | by ( 540 | metis_tac[move_fn_majority_tensor_guests_equiv_swap_party, 541 | move_fn_majority_guest_equiv_party, 542 | homotopy_equiv_trans, homotopy_equiv_sym, 543 | homotopy_equiv_tensor]) 544 | \\ pop_assum mp_tac 545 | \\ simp[homotopy_equiv_def] 546 | \\ CCONTR_TAC \\ fs[] 547 | \\ qmatch_asmsub_abbrev_tac`f :- swap gp → tgp -: _` 548 | \\ `∃e. e ∈ tgp.env ∧ 549 | ∀a. a ∈ tgp.agent ⇒ tgp.eval a e = "N"` 550 | by( 551 | simp[Abbr`tgp`, tensor_eval] 552 | \\ simp[Once tensor_def, PULL_EXISTS, hom_def] 553 | \\ qexists_tac`mk_chu_morphism gp (swap gp) <| 554 | map_agent := K""; map_env := K"" |>` 555 | \\ conj_asm1_tac 556 | >- ( 557 | simp[maps_to_in_chu, Abbr`gp`] 558 | \\ simp[is_chu_morphism_def, mk_chu_morphism_def] 559 | \\ simp[restrict_def] 560 | \\ simp[guest_party_eval] 561 | \\ simp[guest_party_def] 562 | \\ rpt gen_tac \\ strip_tac \\ simp[]) 563 | \\ DEP_REWRITE_TAC[Q.GEN`w`decode_encode_chu_morphism] 564 | \\ conj_tac >- metis_tac[] 565 | \\ simp[tensor_def, PULL_EXISTS, EXISTS_PROD, hom_def] 566 | \\ simp[mk_chu_morphism_def, restrict_def] 567 | \\ simp[Abbr`gp`, guest_party_eval] 568 | \\ simp[guest_party_def] 569 | \\ rpt gen_tac \\ strip_tac \\ simp[]) 570 | \\ `∀a. a ∈ gp.env ⇒ (swap gp).eval a (f.map.map_env e) = "N"` 571 | by metis_tac[swap_components, maps_to_in_chu, is_chu_morphism_def] 572 | \\ `f.map.map_env e ∈ gp.agent` 573 | by metis_tac[swap_components, maps_to_in_chu, is_chu_morphism_def] 574 | \\ pop_assum mp_tac 575 | \\ first_x_assum(qspec_then`" "`mp_tac) 576 | \\ simp[Abbr`gp`, guest_party_def, mk_cf_def, PULL_EXISTS] 577 | \\ IF_CASES_TAC \\ fs[] 578 | QED 579 | 580 | (* TODO comparison to example with coins and dictators voting rule *) 581 | 582 | val _ = export_theory(); 583 | -------------------------------------------------------------------------------- /ex7Script.sml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright 2021 DeepMind Technologies Limited. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | https://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | *) 16 | 17 | open HolKernel boolLib bossLib boolSimps Parse dep_rewrite 18 | pred_setTheory listTheory sortingTheory categoryTheory 19 | matrixLib matrixTheory 20 | cf0Theory cf1Theory cf2Theory cf5Theory cf6Theory cf7Theory 21 | ex1Theory 22 | 23 | val _ = new_theory"ex7"; 24 | 25 | Definition pd_def: 26 | pd = mk_cf <| world := {"0"; "1"; "2"; "3"}; 27 | agent := {"c"; "d"}; 28 | env := {"c"; "d"}; 29 | eval := λa b. 30 | if a = b then 31 | if a = "c" then "2" else "1" 32 | else if a = "c" then "0" else "3" |> 33 | End 34 | 35 | Theorem cf_matrix_pd: 36 | cf_matrix pd = 37 | [["2"; "0"]; 38 | ["3"; "1"]] 39 | Proof 40 | rw[pd_def, cf_matrix_def, mk_cf_def] 41 | \\ qsort_set_to_list_tac 42 | \\ EVAL_TAC 43 | QED 44 | 45 | Definition ac_def: 46 | ac = mk_cf (pd with agent := {"c"}) 47 | End 48 | 49 | Definition ad_def: 50 | ad = mk_cf (pd with agent := {"d"}) 51 | End 52 | 53 | Theorem cf_matrix_ac: 54 | cf_matrix ac = [["2"; "0"]] 55 | Proof 56 | rw[ac_def, pd_def, cf_matrix_def, mk_cf_def] 57 | \\ qsort_set_to_list_tac 58 | \\ EVAL_TAC 59 | \\ qexists_tac`"c"` \\ simp[] 60 | QED 61 | 62 | Theorem cf_matrix_ad: 63 | cf_matrix ad = [["3"; "1"]] 64 | Proof 65 | rw[ad_def, pd_def, cf_matrix_def, mk_cf_def] 66 | \\ qsort_set_to_list_tac 67 | \\ EVAL_TAC 68 | \\ qexists_tac`"d"` \\ simp[] 69 | QED 70 | 71 | Theorem cf_matrix_ac_sum_ad: 72 | ∃p. p PERMUTES count (CARD (sum ac ad).env) ∧ 73 | cf_matrix (sum ac ad) = permute_cols p 74 | [["2"; "0"; "2"; "0"]; 75 | ["3"; "1"; "1"; "3"]] 76 | Proof 77 | rw[cf_matrix_def, sum_def] 78 | \\ rw[EVAL``ac.env``] \\ rw[EVAL``ad.env``] 79 | \\ rw[EVAL``ac.agent``] \\ rw[EVAL``ad.agent``] 80 | \\ rw[EVAL``ac.world``] \\ rw[EVAL``ad.world``] 81 | \\ CONV_TAC(ONCE_DEPTH_CONV(fn tm => 82 | if pred_setSyntax.is_image tm orelse 83 | pred_setSyntax.is_union tm then 84 | EVAL tm else NO_CONV tm)) 85 | \\ qsort_set_to_list_tac 86 | \\ qexists_tac`λn. if n = 1 then 2 else 87 | if n = 2 then 3 else 88 | if n = 3 then 1 else n` 89 | \\ EVAL_TAC 90 | \\ rw[BIJ_IFF_INV] 91 | \\ qexists_tac`λn. if n = 1 then 3 else 92 | if n = 2 then 1 else 93 | if n = 3 then 2 else n` 94 | \\ rw[] 95 | QED 96 | 97 | Definition uc_def: 98 | uc = mk_cf <| world := {"0"; "1"}; 99 | agent := {"p"; "s"}; 100 | env := {"p"; "s"}; 101 | eval := λa e. if a = "s" ∧ e = "s" 102 | then "1" else "0" |> 103 | End 104 | 105 | Theorem cf_matrix_uc: 106 | cf_matrix uc = [["0"; "0"]; ["0"; "1"]] 107 | Proof 108 | rw[cf_matrix_def, uc_def] 109 | \\ qsort_set_to_list_tac 110 | \\ EVAL_TAC 111 | QED 112 | 113 | Theorem swap_uc: 114 | swap uc = uc 115 | Proof 116 | rw[swap_def, uc_def, cf_component_equality] 117 | \\ rw[mk_cf_def, FUN_EQ_THM] 118 | \\ rw[] 119 | QED 120 | 121 | Theorem uc_in_chu_objects: 122 | uc ∈ chu_objects uc.world 123 | Proof 124 | rw[chu_objects_def] 125 | \\ rw[uc_def] 126 | \\ EVAL_TAC 127 | \\ rw[SUBSET_DEF] 128 | QED 129 | 130 | Definition pp_def: 131 | pp = mk_chu_morphism uc uc 132 | <| map_agent := K "p"; map_env := K "p" |> 133 | End 134 | 135 | Theorem pp_maps_to: 136 | pp :- uc → uc -: chu uc.world 137 | Proof 138 | rw[maps_to_in_chu, uc_in_chu_objects] 139 | \\ rw[pp_def] 140 | \\ rw[is_chu_morphism_def, mk_chu_morphism_def] 141 | \\ rpt (pop_assum mp_tac) 142 | \\ EVAL_TAC \\ rw[] 143 | QED 144 | 145 | Theorem hom_uc: 146 | (chu uc.world |uc → uc|) = { id uc -: chu uc.world; pp } 147 | Proof 148 | reverse(rw[hom_def, SET_EQ_SUBSET]) 149 | >- simp[pp_maps_to] 150 | >- ( irule id_maps_to \\ simp[uc_in_chu_objects] ) 151 | \\ rw[SUBSET_DEF, maps_to_in_chu] 152 | \\ fs[is_chu_morphism_def] 153 | \\ rw[morphism_component_equality] 154 | \\ simp[chu_morphism_map_component_equality] 155 | \\ simp[chu_id_morphism_map_def, pp_def, mk_chu_morphism_def] 156 | \\ simp[restrict_def, FUN_EQ_THM] 157 | \\ fs[extensional_def] 158 | \\ `uc.agent = uc.env` by EVAL_TAC \\ gs[] 159 | \\ simp[GSYM FORALL_AND_THM] 160 | \\ qmatch_goalsub_abbrev_tac`P ∨ _` 161 | \\ Cases_on`P = T` \\ simp[Abbr`P`] 162 | \\ disj2_tac 163 | \\ qx_gen_tac`a` 164 | \\ reverse IF_CASES_TAC >- metis_tac[] 165 | \\ qpat_x_assum`_ ≠ T`mp_tac 166 | \\ simp[] 167 | \\ disch_then(qx_choose_then`b`mp_tac) 168 | \\ Cases_on`b ∈ uc.env` \\ simp[] 169 | \\ `∀x. x ∈ uc.env ⇔ (x = "s" ∨ x = "p")` 170 | by (EVAL_TAC \\ simp[] \\ metis_tac[]) 171 | \\ `∀x y. x ∈ uc.env ∧ y ∈ uc.env ⇒ 172 | (uc.eval x y = if x = "s" ∧ y = "s" then "1" else "0")` 173 | by ( simp[] \\ EVAL_TAC \\ rw[] ) 174 | \\ Cases_on`x.map.map_agent a = "p"` \\ simp[] 175 | \\ metis_tac[EVAL``"s"="p"``, EVAL``"1"="0"``] 176 | QED 177 | 178 | Theorem cf_matrix_uc_tensor_uc: 179 | ∃p. p PERMUTES count 2 ∧ 180 | cf_matrix (tensor uc uc) = 181 | permute_cols p 182 | [["0"; "0"]; 183 | ["0"; "0"]; 184 | ["0"; "0"]; 185 | ["1"; "0"]] 186 | Proof 187 | rw[tensor_def, cf_matrix_def] 188 | \\ simp[swap_uc, hom_uc] 189 | \\ CONV_TAC(ONCE_DEPTH_CONV(fn tm => 190 | if pred_setSyntax.is_image tm then 191 | EVAL tm else NO_CONV tm)) 192 | \\ qsort_set_to_list_tac 193 | \\ IF_CASES_TAC 194 | >- ( 195 | `id uc -:chu uc.world = pp` by 196 | metis_tac[id_maps_to, decode_encode_chu_morphism, pp_maps_to, 197 | is_category_chu, chu_obj, uc_in_chu_objects] 198 | \\ `F` suffices_by rw[] 199 | \\ pop_assum mp_tac 200 | \\ simp[morphism_component_equality, chu_morphism_map_component_equality, pp_def, uc_in_chu_objects] 201 | \\ simp[mk_chu_morphism_def, FUN_EQ_THM, restrict_def, chu_id_morphism_map_def] 202 | \\ strip_tac 203 | \\ qexists_tac`"s"` 204 | \\ EVAL_TAC ) 205 | \\ CONV_TAC(PATH_CONV"brrr"EVAL) 206 | \\ qmatch_goalsub_abbrev_tac`QSORT R [m1; m2]` 207 | \\ `decode_morphism uc uc m1 = id uc -:chu uc.world ∧ 208 | decode_morphism uc uc m2 = pp` 209 | by metis_tac[decode_encode_chu_morphism, id_maps_to, pp_maps_to, 210 | is_category_chu, chu_obj, uc_in_chu_objects] 211 | \\ `PERM [m1; m2] (QSORT R [m1; m2])` by metis_tac[QSORT_PERM] 212 | \\ pop_assum mp_tac 213 | \\ CONV_TAC(LAND_CONV(SIMP_CONV(srw_ss()) 214 | [PERM_CONS_EQ_APPEND, APPEND_EQ_SING])) 215 | \\ strip_tac \\ gs[mk_cf_def] 216 | \\ simp[uc_in_chu_objects] 217 | \\ CONV_TAC(PATH_CONV"brr"EVAL) 218 | \\ TRY ( 219 | qexists_tac`λn. 1 - n` 220 | \\ reverse conj_tac >- EVAL_TAC 221 | \\ simp[BIJ_IFF_INV] 222 | \\ qexists_tac`λn. 1 - n` 223 | \\ rw[] ) 224 | \\ qexists_tac`I` 225 | \\ reverse conj_tac >- EVAL_TAC 226 | \\ metis_tac[BIJ_ID, combinTheory.I_THM] 227 | QED 228 | 229 | (* TODO: subsums and subtensors of these examples *) 230 | 231 | Theorem no_subtensors: 232 | ∃c d w. 233 | c ∈ chu_objects w ∧ d ∈ chu_objects w ∧ 234 | ∀t. ¬is_subtensor c d t 235 | Proof 236 | qexists_tac`test_yesterday` 237 | \\ qexists_tac`swap test_demanding` 238 | \\ qexists_tac`test_world` 239 | \\ simp[] 240 | \\ rw[is_subtensor_def] 241 | \\ qmatch_goalsub_abbrev_tac`tensor c d` 242 | \\ `(tensor c d).env = ∅` 243 | by ( 244 | rw[tensor_def] 245 | \\ rw[Abbr`c`, Abbr`d`, hom_def, EXTENSION] 246 | \\ rw[maps_to_in_chu] 247 | \\ metis_tac[no_morphisms_yesterday_demanding] ) 248 | \\ simp[] 249 | \\ CCONTR_TAC \\ gs[restrict_def] 250 | \\ fs[homotopy_equiv_def] 251 | \\ fs[maps_to_in_chu] 252 | \\ fs[is_chu_morphism_def] 253 | \\ qpat_x_assum`∀e. e ∉ c.env`mp_tac 254 | \\ simp[Abbr`c`] 255 | \\ EVAL_TAC 256 | \\ simp[] 257 | \\ metis_tac[] 258 | QED 259 | 260 | val _ = export_theory(); 261 | -------------------------------------------------------------------------------- /ex9Script.sml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright 2021 DeepMind Technologies Limited. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | https://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | *) 16 | 17 | open HolKernel boolLib bossLib Parse dep_rewrite 18 | pairTheory pred_setTheory categoryTheory 19 | cf0Theory ex0Theory cf1Theory cf2Theory cf9Theory 20 | 21 | val _ = new_theory"ex9"; 22 | 23 | Theorem runs3_cf_assume_no_meteor: 24 | cf_assume_diff {"m"} runs_cf3 25 | = runs_cf2 with world := runs_cf3.world 26 | Proof 27 | rw[cf_assume_diff_def] 28 | \\ rw[runs_cf2_def, runs_cf3_def, cf_component_equality] 29 | \\ rw[mk_cf_def] 30 | \\ rw[FUN_EQ_THM] 31 | \\ rw[] 32 | QED 33 | 34 | Theorem runs3_assume_no_meteor: 35 | assume_diff {"m"} runs_cf3 36 | = runs_cf2 with world := runs_cf3.world 37 | Proof 38 | rw[assume_diff_def, GSYM runs3_cf_assume_no_meteor] 39 | \\ AP_THM_TAC \\ AP_TERM_TAC 40 | \\ dsimp[runs_cf3_def, SET_EQ_SUBSET, SUBSET_DEF] 41 | \\ dsimp[EVAL``runs_cf2.env``] 42 | \\ dsimp[EVAL``runs_cf2.agent``] 43 | \\ EVAL_TAC 44 | QED 45 | 46 | Theorem commit_diff_not_iso_commit: 47 | ∃w c s. 48 | c ∈ chu_objects w ∧ s ⊆ w ∧ 49 | ¬ (commit_diff s c ≅ commit (w DIFF s) c -: chu w) 50 | Proof 51 | qabbrev_tac`w = {"0";"1"}` 52 | \\ qexists_tac`w` 53 | \\ qexists_tac`cf1 w w` 54 | \\ qexists_tac`{"0"}` 55 | \\ conj_tac >- simp[Abbr`w`] 56 | \\ conj_tac >- simp[Abbr`w`] 57 | \\ simp[iso_objs_thm] 58 | \\ CCONTR_TAC \\ fs[] 59 | \\ fs[chu_iso_bij] 60 | \\ gs[maps_to_in_chu] 61 | \\ ntac 2 (pop_assum mp_tac) 62 | \\ simp[commit_diff_def, commit_def, cf1_def, mk_cf_def] 63 | \\ simp[cf_commit_diff_def, cf_commit_def] 64 | \\ dsimp[Abbr`w`] 65 | \\ qmatch_goalsub_abbrev_tac`BIJ _ _ s` 66 | \\ `s = ∅` by simp[EXTENSION, Abbr`s`] 67 | \\ rw[] 68 | QED 69 | 70 | val _ = export_theory(); 71 | -------------------------------------------------------------------------------- /exaScript.sml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright 2021 DeepMind Technologies Limited. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | https://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | *) 16 | 17 | open HolKernel boolLib bossLib Parse dep_rewrite 18 | pred_setTheory listTheory sortingTheory 19 | cf0Theory ex0Theory cf1Theory cf2Theory cf6Theory cf9Theory cfaTheory 20 | 21 | val _ = new_theory"exa"; 22 | 23 | Definition rs_def: 24 | rs = {{"ur";"nr"};{"us";"ns"}} 25 | End 26 | 27 | Theorem partitions_rs: 28 | rs partitions runs_cf1.world 29 | Proof 30 | rw[partitions_thm, rs_def, runs_cf1_def] 31 | \\ rw[SUBSET_DEF, EXISTS_UNIQUE_THM] 32 | \\ gs[] \\ dsimp[] 33 | QED 34 | 35 | Theorem rs_in_obs_part_runs_cf2: 36 | rs ∈ obs_part runs_cf2 37 | Proof 38 | rw[obs_part_def, partitions_rs] 39 | \\ rw[runs2_obs, union_closure_def] 40 | \\ fs[rs_def, SUBSET_DEF] 41 | \\ metis_tac[BIGUNION_SING, IN_SING] 42 | QED 43 | 44 | Theorem runs_cf2_eval: 45 | runs_cf2.eval a e = 46 | if a ∈ runs_cf2.agent ∧ e ∈ runs_cf2.env then 47 | (if LENGTH a < 2 then EL 0 a else 48 | if EL 0 e = EL 0 a then EL 1 a else EL 2 a) 49 | :: e 50 | else ARB 51 | Proof 52 | rw[runs_cf2_def, mk_cf_def] 53 | QED 54 | 55 | Theorem rs_in_obs_part_conditional_policies_runs_cf2: 56 | rs ∈ obs_part runs_cf2 57 | Proof 58 | DEP_REWRITE_TAC[Q.SPEC`runs_cf1.world`(Q.GEN`w`obs_part_conditional_policies)] 59 | \\ conj_asm1_tac 60 | >- (simp[in_chu_objects] \\ EVAL_TAC) 61 | \\ conj_asm1_tac >- rw[partitions_rs] 62 | \\ rw[] 63 | \\ qpat_x_assum`_ ⊆ _`mp_tac 64 | \\ simp[Once rs_def] 65 | \\ strip_tac 66 | \\ qmatch_assum_abbrev_tac`f s ∈ _` 67 | \\ ntac 2 (pop_assum mp_tac) 68 | \\ qmatch_assum_abbrev_tac`f r ∈ _` 69 | \\ ntac 2 strip_tac 70 | \\ qexists_tac` 71 | if f r = "u" ∧ f s = "u" then "u" else 72 | if f r = "u" ∧ f s = "n" then "run" else 73 | if f r = "u" ∧ f s = "run" then "run" else 74 | if f r = "u" ∧ f s = "sun" then "u" else 75 | if f r = "n" ∧ f s = "u" then "sun" else 76 | if f r = "n" ∧ f s = "n" then "n" else 77 | if f r = "n" ∧ f s = "run" then "n" else 78 | if f r = "n" ∧ f s = "sun" then "sun" else 79 | if f r = "run" ∧ f s = "u" then "u" else 80 | if f r = "run" ∧ f s = "n" then "run" else 81 | if f r = "run" ∧ f s = "run" then "run" else 82 | if f r = "run" ∧ f s = "sun" then "u" else 83 | if f r = "sun" ∧ f s = "u" then "sun" else 84 | if f r = "sun" ∧ f s = "n" then "n" else 85 | if f r = "sun" ∧ f s = "run" then "n" else 86 | if f r = "sun" ∧ f s = "sun" then "sun" else ARB` 87 | \\ qmatch_goalsub_abbrev_tac`af ∈ _` 88 | \\ conj_asm1_tac 89 | >- ( fs[runs_cf2_def] \\ simp[Abbr`af`] ) 90 | \\ rpt strip_tac 91 | \\ SELECT_ELIM_TAC 92 | \\ conj_tac >- metis_tac[in_chu_objects, partitions_thm, wf_def] 93 | \\ simp[rs_def] 94 | \\ dsimp[runs_cf2_eval] 95 | \\ qpat_x_assum`f _ ∈ _`mp_tac 96 | \\ qpat_x_assum`f _ ∈ _`mp_tac 97 | \\ simp[runs_cf2_def] 98 | \\ strip_tac \\ gs[] 99 | \\ strip_tac \\ gs[] 100 | \\ rw[Abbr`af`] 101 | \\ rw[Abbr`r`,Abbr`s`] 102 | \\ strip_tac \\ fs[runs_cf2_def] 103 | QED 104 | 105 | Theorem runs_cf2_as_product: 106 | runs_cf2 ≃ assume {"ur";"nr"} runs_cf2 && assume {"us";"ns"} runs_cf2 107 | -: runs_cf1.world 108 | Proof 109 | mp_tac rs_in_obs_part_runs_cf2 110 | \\ `runs_cf2 ∈ chu_objects runs_cf1.world` 111 | by simp[in_chu_objects] 112 | \\ imp_res_tac in_chu_objects_finite_world 113 | \\ drule obs_part_assuming 114 | \\ impl_tac >- EVAL_TAC 115 | \\ disch_then SUBST_ALL_TAC 116 | \\ simp[obs_part_assuming_def] 117 | \\ strip_tac 118 | \\ irule homotopy_equiv_trans 119 | \\ goal_assum(first_assum o mp_then Any mp_tac) 120 | \\ qmatch_goalsub_abbrev_tac`assume r _ && assume s _` 121 | \\ qmatch_goalsub_abbrev_tac`FOLDL prod t (MAP f _)` 122 | \\ irule homotopy_equiv_trans 123 | \\ rw[rs_def] 124 | \\ qexists_tac`FOLDL prod t (MAP f [r; s])` 125 | \\ conj_tac 126 | >- ( 127 | irule FOLDL_PERM_equiv 128 | \\ rpt (conj_tac >- simp[]) 129 | \\ conj_tac >- simp[EVERY_MAP, Abbr`f`] 130 | \\ conj_tac 131 | >- ( 132 | irule PERM_MAP 133 | \\ irule PERM_ALL_DISTINCT 134 | \\ simp[] 135 | \\ simp[Abbr`r`, Abbr`s`, EXTENSION] 136 | \\ qexists_tac`"ur"` \\ simp[]) 137 | \\ simp[Abbr`t`]) 138 | \\ simp[] 139 | \\ irule homotopy_equiv_prod 140 | \\ simp[Abbr`f`, Abbr`t`] 141 | \\ irule iso_homotopy_equiv 142 | \\ metis_tac[prod_cfT, assume_in_chu_objects] 143 | QED 144 | 145 | Theorem runs_cf2_as_product_of_tensors: 146 | let w = runs_cf1.world in 147 | runs_cf2 ≃ tensor (cf1 w {"ur";"nr"}) runs_cf2 && 148 | tensor (cf1 w {"us";"ns"}) runs_cf2 -: w 149 | Proof 150 | rw[] 151 | \\ irule homotopy_equiv_trans 152 | \\ goal_assum(C (mp_then Any mp_tac) runs_cf2_as_product) 153 | \\ irule homotopy_equiv_prod 154 | \\ `runs_cf2 ∈ chu_objects runs_cf1.world` by simp[in_chu_objects] 155 | \\ imp_res_tac in_chu_objects_finite_world 156 | \\ `{"ur";"nr"} ⊆ runs_cf1.world` by EVAL_TAC 157 | \\ `{"us";"ns"} ⊆ runs_cf1.world` by EVAL_TAC 158 | \\ simp[] 159 | \\ metis_tac[assume_tensor_cf1, iso_homotopy_equiv] 160 | QED 161 | 162 | Theorem runs_cf2_as_tensor: 163 | let r = {"ur";"nr"} in 164 | let s = {"us";"ns"} in 165 | let w = runs_cf1.world in 166 | runs_cf2 ≃ tensor (assume r runs_cf2 && cf1 w s) 167 | (assume s runs_cf2 && cf1 w r) -: w 168 | Proof 169 | BasicProvers.LET_ELIM_TAC 170 | \\ mp_tac rs_in_obs_part_runs_cf2 171 | \\ `runs_cf2 ∈ chu_objects runs_cf1.world` by simp[in_chu_objects] 172 | \\ imp_res_tac in_chu_objects_finite_world 173 | \\ drule obs_part_mult_constructive 174 | \\ impl_tac >- EVAL_TAC 175 | \\ disch_then SUBST_ALL_TAC 176 | \\ simp[obs_part_mult_constructive_def] 177 | \\ simp[Once runs_cf2_def] 178 | \\ strip_tac 179 | \\ irule homotopy_equiv_trans 180 | \\ goal_assum(first_assum o mp_then Any mp_tac) 181 | \\ qmatch_goalsub_abbrev_tac`FOLDL tensor t (MAP f _)` 182 | \\ irule homotopy_equiv_trans 183 | \\ rw[rs_def] 184 | \\ qexists_tac`FOLDL tensor t (MAP f [r; s])` 185 | \\ conj_tac 186 | >- ( 187 | irule FOLDL_PERM_equiv 188 | \\ rpt (conj_tac >- simp[]) 189 | \\ conj_tac >- ( 190 | simp[EVERY_MAP, Abbr`f`] 191 | \\ simp[EVERY_MEM] 192 | \\ gen_tac \\ disch_then assume_tac 193 | \\ irule prod_in_chu_objects 194 | \\ simp[Abbr`w`] 195 | \\ irule cf1_in_chu_objects 196 | \\ simp[SUBSET_DEF] ) 197 | \\ conj_tac 198 | >- ( 199 | irule PERM_MAP 200 | \\ irule PERM_ALL_DISTINCT 201 | \\ simp[] 202 | \\ simp[Abbr`r`, Abbr`s`, EXTENSION] 203 | \\ qexists_tac`"ur"` \\ simp[]) 204 | \\ simp[Abbr`t`, Abbr`w`]) 205 | \\ simp[] 206 | \\ irule homotopy_equiv_tensor 207 | \\ simp[Abbr`f`, Abbr`t`] 208 | \\ `image runs_cf2 = w` by ( 209 | simp[image_def, EXTENSION, runs_cf2_def, mk_cf_def, Abbr`w`] 210 | \\ rw[runs_cf1_def, EQ_IMP_THM] 211 | \\ dsimp[]) 212 | \\ simp[DIFF_INTER] 213 | \\ `w DIFF r = s ∧ w DIFF s = r` 214 | by ( simp[Abbr`r`,Abbr`s`,Abbr`w`, runs_cf1_def] ) 215 | \\ `r ⊆ w ∧ s ⊆ w` by fs[rs_def, partitions_thm] 216 | \\ rfs[Abbr`w`] 217 | \\ irule iso_homotopy_equiv 218 | \\ irule (DISCH_ALL(CONJUNCT2(UNDISCH tensor_cf1))) 219 | \\ simp[] 220 | QED 221 | 222 | Theorem runs_cf2_as_tensor_of_products: 223 | let r = {"ur";"nr"} in 224 | let s = {"us";"ns"} in 225 | let w = runs_cf1.world in 226 | runs_cf2 ≃ tensor (tensor (cf1 w r) runs_cf2 && cf1 w s) 227 | (tensor (cf1 w s) runs_cf2 && cf1 w r) 228 | -: w 229 | Proof 230 | BasicProvers.LET_ELIM_TAC 231 | \\ mp_tac runs_cf2_as_tensor 232 | \\ simp[] \\ strip_tac 233 | \\ irule homotopy_equiv_trans 234 | \\ goal_assum(first_assum o mp_then Any mp_tac) 235 | \\ irule homotopy_equiv_tensor 236 | \\ assume_tac partitions_rs \\ rfs[] 237 | \\ `r ⊆ w ∧ s ⊆ w` by fs[rs_def, partitions_thm] 238 | \\ `FINITE w` by metis_tac[homotopy_equiv_in_chu_objects, 239 | in_chu_objects_finite_world] 240 | \\ `runs_cf2 ∈ chu_objects w` by simp[in_chu_objects] 241 | \\ conj_tac 242 | \\ irule homotopy_equiv_prod 243 | \\ simp[] 244 | \\ irule iso_homotopy_equiv 245 | \\ simp[assume_tensor_cf1] 246 | QED 247 | 248 | val _ = export_theory(); 249 | -------------------------------------------------------------------------------- /ffs/Holmakefile: -------------------------------------------------------------------------------- 1 | # Copyright 2021 DeepMind Technologies Limited. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # https://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | INCLUDES=..\ 16 | $(HOLDIR)/examples/algebra/ring\ 17 | $(HOLDIR)/examples/algebra/polynomial\ 18 | $(HOLDIR)/examples/algebra/field\ 19 | $(HOLDIR)/examples/algebra/multipoly 20 | -------------------------------------------------------------------------------- /ffs/partitionScript.sml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright 2021 DeepMind Technologies Limited. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | https://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | *) 16 | 17 | open HolKernel boolLib bossLib Parse dep_rewrite 18 | arithmeticTheory pred_setTheory pairTheory listTheory 19 | helperSetTheory 20 | 21 | val _ = new_theory"partition"; 22 | 23 | Definition BIGdisjUNION_def: 24 | BIGdisjUNION sos = { (s, x) | s IN sos /\ x IN s } 25 | End 26 | 27 | Theorem BINARY_BIGdisjUNION: 28 | a <> b ==> 29 | BIJ (\(s, x). (if s = a then INL else INR) x) 30 | (BIGdisjUNION {a; b}) (disjUNION a b) 31 | Proof 32 | rw[BIJ_IFF_INV] 33 | >- ( fs[BIGdisjUNION_def] \\ rw[] ) 34 | \\ qexists_tac`\x. sum_CASE x (\y. (a,y)) (\y. (b,y))` 35 | \\ rw[BIGdisjUNION_def, disjUNION_def] 36 | \\ rw[] 37 | QED 38 | 39 | Theorem partitions_BIJ_BIGdisjUNION: 40 | v partitions w <=> 41 | BIJ SND (BIGdisjUNION v) w /\ {} NOTIN v 42 | Proof 43 | reverse(Cases_on`BIGUNION v ⊆ w`) 44 | >- ( 45 | `¬(v partitions w)` by ( fs[partitions_thm, SUBSET_DEF] \\ METIS_TAC[] ) 46 | \\ simp[] 47 | \\ Cases_on`{} IN v` \\ simp[] 48 | \\ strip_tac 49 | \\ fs[BIJ_DEF, INJ_DEF] 50 | \\ fs[SUBSET_DEF, BIGdisjUNION_def, PULL_EXISTS] 51 | \\ metis_tac[]) 52 | \\ `!x. x IN (BIGdisjUNION v) ==> SND x IN w` 53 | by ( 54 | rw[BIGdisjUNION_def] 55 | \\ fs[SUBSET_DEF, PULL_EXISTS] 56 | \\ metis_tac[]) 57 | \\ reverse eq_tac 58 | >- ( 59 | rw[partitions_thm] 60 | >- metis_tac[] 61 | >- (fs[SUBSET_DEF, PULL_EXISTS] \\ METIS_TAC[]) 62 | \\ simp[EXISTS_UNIQUE_ALT] 63 | \\ fs[BIJ_IFF_INV] 64 | \\ qexists_tac`FST (g y)` 65 | \\ fs[BIGdisjUNION_def, PULL_EXISTS] 66 | \\ res_tac \\ fs[] 67 | \\ strip_tac \\ reverse eq_tac >- metis_tac[] 68 | \\ strip_tac \\ res_tac \\ fs[]) 69 | \\ strip_tac 70 | \\ imp_res_tac partitions_thm 71 | \\ reverse conj_tac >- metis_tac[] 72 | \\ simp[BIJ_IFF_INV] 73 | \\ qexists_tac`\x. (part v x, x)` 74 | \\ fs[BIGdisjUNION_def] 75 | \\ conj_tac >- metis_tac[in_part, part_in_partition] 76 | \\ rw[PULL_EXISTS] 77 | \\ metis_tac[part_unique, SUBSET_DEF] 78 | QED 79 | 80 | Definition discrete_partition_def: 81 | discrete_partition s = {{x} | x IN s} 82 | End 83 | 84 | Theorem equiv_class_equal: 85 | !z s. z IN s ==> equiv_class (=) s z = {z} 86 | Proof 87 | rw[EXTENSION] 88 | \\ metis_tac[] 89 | QED 90 | 91 | Theorem discrete_partition_partitions: 92 | discrete_partition s partitions s 93 | Proof 94 | rw[partitions_def] 95 | \\ qexists_tac`(=)` 96 | \\ rw[partition_def, equiv_on_def] 97 | >- metis_tac[] 98 | \\ rw[discrete_partition_def, Once EXTENSION] 99 | \\ AP_TERM_TAC 100 | \\ simp[Once FUN_EQ_THM] 101 | \\ metis_tac[equiv_class_equal] 102 | QED 103 | 104 | Theorem part_discrete_partition: 105 | x IN s ==> 106 | part (discrete_partition s) x = {x} 107 | Proof 108 | rw[part_def, discrete_partition_def] 109 | \\ SELECT_ELIM_TAC \\ rw[PULL_EXISTS] 110 | \\ fs[] 111 | QED 112 | 113 | Definition indiscrete_partition_def: 114 | indiscrete_partition s = if s = {} then {} else {s} 115 | End 116 | 117 | Theorem indiscrete_partition_partitions: 118 | indiscrete_partition s partitions s 119 | Proof 120 | rw[partitions_thm, indiscrete_partition_def] 121 | \\ rw[EXISTS_UNIQUE_THM] 122 | QED 123 | 124 | Theorem discrete_refines: 125 | v partitions w ==> discrete_partition w refines v 126 | Proof 127 | rw[refines_def, discrete_partition_def, SUBSET_DEF] \\ rw[] 128 | \\ metis_tac[part_in_partition, in_part] 129 | QED 130 | 131 | Theorem refines_indiscrete: 132 | v partitions w ==> v refines indiscrete_partition w 133 | Proof 134 | rw[refines_def, indiscrete_partition_def, partitions_empty] 135 | \\ metis_tac[partitions_thm] 136 | QED 137 | 138 | Definition common_refinement_def: 139 | common_refinement w sop = 140 | partition (\x y. (!v. v IN sop ==> part v x = part v y)) w 141 | End 142 | 143 | Theorem common_refinement_partitions: 144 | common_refinement w sop partitions w 145 | Proof 146 | rw[common_refinement_def] 147 | \\ rw[partitions_def] 148 | \\ qmatch_goalsub_abbrev_tac`partition R` 149 | \\ qexists_tac`R` \\ rw[] 150 | \\ rw[equiv_on_def, Abbr`R`] 151 | \\ metis_tac[] 152 | QED 153 | 154 | Theorem common_refinement_refines: 155 | (!v. v IN sop ==> v partitions w) /\ v IN sop 156 | ==> common_refinement w sop refines v 157 | Proof 158 | strip_tac 159 | \\ assume_tac common_refinement_partitions 160 | \\ `v partitions w` by metis_tac[] 161 | \\ DEP_REWRITE_TAC[refines_grows_parts] 162 | \\ simp[] 163 | \\ rpt gen_tac \\ strip_tac 164 | \\ fs[common_refinement_def] 165 | \\ qmatch_asmsub_abbrev_tac`partition R` 166 | \\ `R equiv_on w` 167 | by ( simp[equiv_on_def, Abbr`R`] \\ metis_tac[] ) 168 | \\ `{ a | a IN w /\ R a x } = { a | a IN w /\ R a y }` 169 | by metis_tac[part_partition] 170 | \\ pop_assum mp_tac 171 | \\ simp[Once EXTENSION] 172 | \\ strip_tac 173 | \\ `R x y` by metis_tac[equiv_on_def] 174 | \\ fs[Abbr`R`] 175 | QED 176 | 177 | Theorem common_refinement_empty: 178 | common_refinement w {} = indiscrete_partition w 179 | Proof 180 | rw[common_refinement_def, partition_def, indiscrete_partition_def] 181 | \\ rw[Once EXTENSION] 182 | \\ fs[GSYM MEMBER_NOT_EMPTY] 183 | \\ metis_tac[] 184 | QED 185 | 186 | Theorem same_part_common_refinement: 187 | x IN w /\ y IN w /\ (!v. v IN sop ==> part v x = part v y) ==> 188 | part (common_refinement w sop) x = 189 | part (common_refinement w sop) y 190 | Proof 191 | rw[common_refinement_def] 192 | \\ DEP_REWRITE_TAC[part_partition] 193 | \\ rw[] 194 | \\ rw[equiv_on_def] 195 | \\ metis_tac[] 196 | QED 197 | 198 | Theorem same_part_common_refinement_iff: 199 | x IN w /\ y IN w /\ (!v. v IN sop ==> v partitions w) ==> 200 | ((part (common_refinement w sop) x = 201 | part (common_refinement w sop) y) <=> 202 | (!v. v IN sop ==> part v x = part v y)) 203 | Proof 204 | strip_tac 205 | \\ reverse eq_tac 206 | >- metis_tac[same_part_common_refinement] 207 | \\ strip_tac 208 | \\ assume_tac common_refinement_partitions 209 | \\ rpt strip_tac 210 | \\ irule part_unique 211 | \\ reverse conj_tac >- metis_tac[part_in_partition] 212 | \\ drule common_refinement_refines 213 | \\ disch_then drule 214 | \\ metis_tac[in_part, refines_grows_parts] 215 | QED 216 | 217 | Theorem refines_common_refinement: 218 | v partitions w /\ (!x. x IN sop ==> x partitions w /\ v refines x) 219 | ==> 220 | v refines common_refinement w sop 221 | Proof 222 | strip_tac 223 | \\ DEP_REWRITE_TAC[refines_grows_parts] 224 | \\ simp[common_refinement_partitions] 225 | \\ rpt strip_tac 226 | \\ irule same_part_common_refinement 227 | \\ simp[] 228 | \\ qx_gen_tac`z` \\ strip_tac 229 | \\ metis_tac[refines_grows_parts] 230 | QED 231 | 232 | Theorem common_refinement_SUBSET: 233 | c SUBSET d ∧ (!v. v ∈ d ⇒ v partitions w) ==> 234 | common_refinement w d refines common_refinement w c 235 | Proof 236 | strip_tac 237 | \\ irule refines_common_refinement 238 | \\ simp[common_refinement_partitions] 239 | \\ fs[SUBSET_DEF] 240 | \\ metis_tac[common_refinement_refines] 241 | QED 242 | 243 | Theorem common_refinement_SING: 244 | v partitions w ⇒ 245 | common_refinement w {v} = v 246 | Proof 247 | strip_tac 248 | \\ irule refines_antisym 249 | \\ conj_tac >- metis_tac[common_refinement_partitions] 250 | \\ simp[common_refinement_refines] 251 | \\ irule refines_common_refinement 252 | \\ simp[] 253 | QED 254 | 255 | (* not very useful? *) 256 | Theorem IN_common_refinement: 257 | (∀v. v ∈ b ⇒ v partitions w) ∧ s ∈ common_refinement w b ⇒ 258 | ∀v. v ∈ b ⇒ ∃!t. t ∈ v ∧ s ⊆ t 259 | Proof 260 | rw[] 261 | \\ `common_refinement w b partitions w` 262 | by metis_tac[common_refinement_partitions] 263 | \\ `s ≠ {} ∧ s ⊆ w` by metis_tac[partitions_thm] 264 | \\ `∃x. x ∈ s ∧ x ∈ w` by metis_tac[MEMBER_NOT_EMPTY, SUBSET_DEF] 265 | \\ `s = part (common_refinement w b) x` by metis_tac[part_unique] 266 | \\ `common_refinement w b refines v` 267 | by metis_tac[common_refinement_refines] 268 | \\ `∃s2. s2 ∈ v ∧ s ⊆ s2` by metis_tac[refines_def] 269 | \\ `s2 = part v x` by metis_tac[part_unique, SUBSET_DEF] 270 | \\ simp[EXISTS_UNIQUE_THM] 271 | \\ conj_tac >- metis_tac[] 272 | \\ rpt strip_tac 273 | \\ metis_tac[part_unique, SUBSET_DEF] 274 | QED 275 | 276 | Theorem common_refinement_eq_empty: 277 | common_refinement w b = {} <=> w = {} 278 | Proof 279 | rw[common_refinement_def, partition_def, EQ_IMP_THM] 280 | \\ fs[Once EXTENSION] 281 | QED 282 | 283 | (* subpartitions *) 284 | 285 | Definition is_subpartition_def: 286 | is_subpartition w x <=> ?e. e ⊆ w ∧ x partitions e 287 | End 288 | 289 | Definition subpart_domain_def: 290 | subpart_domain w x = @e. e ⊆ w ∧ x partitions e 291 | End 292 | 293 | Theorem subpart_domain_thm: 294 | is_subpartition w x ⇒ 295 | (∀e. e ⊆ w ∧ x partitions e ⇔ e = subpart_domain w x) 296 | Proof 297 | rw[subpart_domain_def] 298 | \\ SELECT_ELIM_TAC \\ rw[] 299 | \\ fs[is_subpartition_def] 300 | >- metis_tac[] 301 | \\ rw[EQ_IMP_THM] 302 | \\ fs[partitions_def] 303 | \\ imp_res_tac BIGUNION_partition 304 | \\ gs[] 305 | QED 306 | 307 | Definition restrict_partition_def: 308 | restrict_partition v e = IMAGE (λx. part v x ∩ e) e 309 | End 310 | 311 | Theorem restrict_partition_partitions: 312 | v partitions w ∧ e ⊆ w ⇒ 313 | restrict_partition v e partitions e 314 | Proof 315 | rw[restrict_partition_def] 316 | \\ fs[partitions_def] 317 | \\ imp_res_tac equiv_on_subset 318 | \\ qexists_tac`R` 319 | \\ simp[Once EXTENSION, PULL_EXISTS] 320 | \\ rw[EQ_IMP_THM] 321 | >- ( 322 | fs[SUBSET_DEF] 323 | \\ rw[part_partition] 324 | \\ rw[partition_def] 325 | \\ goal_assum(first_assum o mp_then Any mp_tac) 326 | \\ simp[Once EXTENSION] 327 | \\ metis_tac[equiv_on_def]) 328 | \\ fs[partition_element] 329 | \\ goal_assum(first_assum o mp_then Any mp_tac) 330 | \\ fs[SUBSET_DEF] 331 | \\ simp[part_partition] 332 | \\ simp[Once EXTENSION] 333 | \\ metis_tac[equiv_on_def] 334 | QED 335 | 336 | Theorem part_restrict_partition: 337 | v partitions w ∧ e ⊆ w ∧ x ∈ e ⇒ 338 | part (restrict_partition v e) x = part v x ∩ e 339 | Proof 340 | strip_tac 341 | \\ imp_res_tac restrict_partition_partitions 342 | \\ irule EQ_SYM 343 | \\ irule part_unique 344 | \\ simp[] 345 | \\ `x ∈ w` by fs[SUBSET_DEF] 346 | \\ conj_tac >- metis_tac[in_part] 347 | \\ reverse conj_tac >- metis_tac[] 348 | \\ simp[restrict_partition_def] 349 | \\ metis_tac[] 350 | QED 351 | 352 | Theorem partition_is_subpartition: 353 | v partitions w ⇒ 354 | is_subpartition w v ∧ 355 | subpart_domain w v = w 356 | Proof 357 | strip_tac 358 | \\ conj_asm1_tac >- 359 | (rw[is_subpartition_def] \\ metis_tac[SUBSET_REFL]) 360 | \\ metis_tac[subpart_domain_thm, SUBSET_REFL] 361 | QED 362 | 363 | Theorem is_subpartition_common_refinement: 364 | e ⊆ w 365 | ⇒ 366 | is_subpartition w (common_refinement e sop) ∧ 367 | subpart_domain w (common_refinement e sop) = e 368 | Proof 369 | strip_tac 370 | \\ conj_asm1_tac 371 | >- ( 372 | simp[is_subpartition_def] 373 | \\ qexists_tac`e` \\ simp[common_refinement_partitions]) 374 | \\ simp[GSYM subpart_domain_thm, common_refinement_partitions] 375 | QED 376 | 377 | Theorem restrict_discrete_partition: 378 | e ⊆ w ⇒ 379 | restrict_partition (discrete_partition w) e = discrete_partition e 380 | Proof 381 | rw[restrict_partition_def] 382 | \\ fs[SUBSET_DEF] 383 | \\ rw[Once EXTENSION] 384 | \\ rw[EQ_IMP_THM] 385 | >- ( gs[part_discrete_partition] 386 | \\ rw[SING_INTER] 387 | \\ gs[discrete_partition_def]) 388 | \\ qexists_tac`CHOICE x` 389 | \\ pop_assum mp_tac 390 | \\ simp[Once discrete_partition_def] 391 | \\ strip_tac \\ rw[] 392 | \\ simp[part_discrete_partition] 393 | \\ rw[SING_INTER] 394 | QED 395 | 396 | Theorem part_indiscrete_partition: 397 | x ∈ w ⇒ 398 | part (indiscrete_partition w) x = w 399 | Proof 400 | rw[indiscrete_partition_def] 401 | \\ rw[part_def] 402 | \\ SELECT_ELIM_TAC 403 | \\ rw[] 404 | QED 405 | 406 | Theorem restrict_indiscrete_partition: 407 | e ⊆ w ⇒ 408 | restrict_partition (indiscrete_partition w) e = indiscrete_partition e 409 | Proof 410 | rw[indiscrete_partition_def] 411 | \\ rw[restrict_partition_def] 412 | \\ rw[IMAGE_EQ_SING] 413 | \\ `x ∈ w` by metis_tac[SUBSET_DEF] 414 | \\ drule part_indiscrete_partition 415 | \\ rw[indiscrete_partition_def] 416 | \\ irule SUBSET_INTER2 417 | \\ rw[] 418 | QED 419 | 420 | Theorem is_subpartition_indiscrete: 421 | e ⊆ w ⇒ 422 | is_subpartition w (indiscrete_partition e) 423 | Proof 424 | rw[is_subpartition_def] 425 | \\ qexists_tac`e` 426 | \\ rw[indiscrete_partition_partitions] 427 | QED 428 | 429 | Theorem subpart_domain_indiscrete: 430 | e ⊆ w ⇒ 431 | subpart_domain w (indiscrete_partition e) = e 432 | Proof 433 | strip_tac 434 | \\ imp_res_tac is_subpartition_indiscrete 435 | \\ drule subpart_domain_thm 436 | \\ metis_tac[indiscrete_partition_partitions] 437 | QED 438 | 439 | Theorem imp_restrict_partition_refines: 440 | v1 refines v2 ∧ v1 partitions w ∧ v2 partitions w ∧ e ⊆ w ⇒ 441 | restrict_partition v1 e refines restrict_partition v2 e 442 | Proof 443 | rw[refines_def] 444 | \\ gs[restrict_partition_def, PULL_EXISTS] 445 | \\ qexists_tac`x` \\ simp[] 446 | \\ `x ∈ w` by metis_tac[SUBSET_DEF] 447 | \\ `part v1 x ∈ v1` by metis_tac[part_in_partition] 448 | \\ `∃s2. s2 ∈ v2 ∧ part v1 x ⊆ s2` by metis_tac[] 449 | \\ `x ∈ part v1 x` by metis_tac[in_part] 450 | \\ `x ∈ s2` by metis_tac[SUBSET_DEF] 451 | \\ `s2 = part v2 x` by metis_tac[part_unique] 452 | \\ gs[SUBSET_DEF] 453 | QED 454 | 455 | Theorem trivial_restrict_partition: 456 | v partitions w ⇒ 457 | restrict_partition v w = v 458 | Proof 459 | rw[restrict_partition_def, Once SET_EQ_SUBSET, SUBSET_DEF] 460 | >- ( 461 | qmatch_asmsub_rename_tac`x ∈ w` 462 | \\ `part v x ∈ v` by metis_tac[part_in_partition] 463 | \\ `part v x ⊆ w` by metis_tac[partitions_thm] 464 | \\ `part v x ∩ w = part v x` by metis_tac[SUBSET_INTER_ABSORPTION] 465 | \\ metis_tac[]) 466 | \\ `x <> {}` by metis_tac[partitions_thm] 467 | \\ `∃z. z ∈ x` by metis_tac[MEMBER_NOT_EMPTY] 468 | \\ qexists_tac`z` 469 | \\ `x ⊆ w` by metis_tac[partitions_thm] 470 | \\ reverse conj_asm2_tac >- metis_tac[SUBSET_DEF] 471 | \\ `x = part v z` by metis_tac[part_unique] 472 | \\ simp[] 473 | \\ simp[GSYM SUBSET_INTER_ABSORPTION] 474 | \\ metis_tac[partitions_thm] 475 | QED 476 | 477 | Theorem restrict_refinement_refines: 478 | (!v. v IN sop ==> v partitions w) ∧ e ⊆ w ⇒ 479 | restrict_partition (common_refinement w sop) e refines 480 | common_refinement e (IMAGE (\v. restrict_partition v e) sop) 481 | Proof 482 | strip_tac 483 | \\ irule refines_common_refinement 484 | \\ simp[PULL_EXISTS] 485 | \\ reverse conj_tac 486 | >- ( 487 | irule restrict_partition_partitions 488 | \\ qexists_tac`w` 489 | \\ simp[common_refinement_partitions] ) 490 | \\ gen_tac \\ strip_tac 491 | \\ conj_tac >- metis_tac[restrict_partition_partitions] 492 | \\ irule imp_restrict_partition_refines 493 | \\ metis_tac[common_refinement_refines, common_refinement_partitions] 494 | QED 495 | 496 | Theorem is_subpartition_discrete: 497 | e ⊆ w ⇒ 498 | is_subpartition w (discrete_partition e) 499 | Proof 500 | rw[is_subpartition_def] 501 | \\ metis_tac[discrete_partition_partitions] 502 | QED 503 | 504 | Theorem subpart_domain_discrete: 505 | e ⊆ w ⇒ 506 | subpart_domain w (discrete_partition e) = e 507 | Proof 508 | strip_tac 509 | \\ metis_tac[subpart_domain_thm, 510 | discrete_partition_partitions, 511 | is_subpartition_discrete] 512 | QED 513 | 514 | Theorem is_subpartition_empty: 515 | is_subpartition w {} 516 | Proof 517 | rw[is_subpartition_def] 518 | QED 519 | 520 | Theorem discrete_partition_empty[simp]: 521 | discrete_partition {} = {} 522 | Proof 523 | rw[discrete_partition_def] 524 | QED 525 | 526 | Theorem is_subpartition_SING: 527 | is_subpartition w {v} ⇔ v ⊆ w ∧ v ≠ ∅ 528 | Proof 529 | rw[is_subpartition_def, SING_partitions] 530 | QED 531 | 532 | Theorem refines_discrete: 533 | v partitions w ⇒ 534 | (v refines discrete_partition w ⇔ v = discrete_partition w) 535 | Proof 536 | strip_tac 537 | \\ rw[EQ_IMP_THM] 538 | \\ irule refines_antisym 539 | \\ rw[discrete_refines] 540 | \\ metis_tac[discrete_partition_partitions] 541 | QED 542 | 543 | Theorem discrete_partition_as_partition: 544 | discrete_partition w = partition (=) w 545 | Proof 546 | rw[discrete_partition_def, partition_def] 547 | \\ rw[SET_EQ_SUBSET, PULL_EXISTS, SUBSET_DEF] 548 | \\ metis_tac[] 549 | QED 550 | 551 | Theorem discrete_eq_indiscrete_SUBSET_SING: 552 | (discrete_partition w = indiscrete_partition w) <=> ∃x. w ⊆ {x} 553 | Proof 554 | rw[discrete_partition_def, indiscrete_partition_def] 555 | \\ rw[EQ_IMP_THM] 556 | \\ fs[Once SET_EQ_SUBSET] 557 | \\ rw[Once SET_EQ_SUBSET] 558 | \\ gs[SUBSET_DEF, PULL_EXISTS] 559 | \\ rw[] 560 | \\ rw[Once SET_EQ_SUBSET] 561 | \\ rw[SUBSET_DEF] 562 | \\ metis_tac[MEMBER_NOT_EMPTY] 563 | QED 564 | 565 | Theorem is_subpartition_restrict: 566 | v partitions w ∧ e ⊆ w ⇒ 567 | is_subpartition w (restrict_partition v e) 568 | Proof 569 | rw[is_subpartition_def] 570 | \\ metis_tac[restrict_partition_partitions] 571 | QED 572 | 573 | Theorem subpart_domain_restrict: 574 | v partitions w ∧ e ⊆ w ⇒ 575 | subpart_domain w (restrict_partition v e) = e 576 | Proof 577 | strip_tac 578 | \\ imp_res_tac is_subpartition_restrict 579 | \\ metis_tac[restrict_partition_partitions, subpart_domain_thm] 580 | QED 581 | 582 | Theorem common_refinement_BIGINTER: 583 | (∀v. v ∈ sop ⇒ v partitions w) ⇒ 584 | common_refinement w sop = 585 | IMAGE (λx. w ∩ BIGINTER (IMAGE (λv. part v x) sop)) w 586 | Proof 587 | rw[common_refinement_def] 588 | \\ rw[Once EXTENSION] 589 | \\ rw[EQ_IMP_THM, partition_def] 590 | \\ goal_assum(first_assum o mp_then Any mp_tac) 591 | \\ rw[Once EXTENSION, PULL_EXISTS] 592 | \\ rw[EQ_IMP_THM] 593 | \\ metis_tac[in_part, part_in_partition, part_unique] 594 | QED 595 | 596 | Theorem FINITE_restrict_partition: 597 | v partitions w ∧ e ⊆ w ∧ FINITE v ⇒ FINITE (restrict_partition v e) 598 | Proof 599 | rw[restrict_partition_def] 600 | \\ irule SUBSET_FINITE 601 | \\ qexists_tac`IMAGE (λp. p ∩ e) v` 602 | \\ simp[SUBSET_DEF, PULL_EXISTS] 603 | \\ qx_gen_tac`z` \\ rw[] 604 | \\ qexists_tac`part v z` 605 | \\ simp[] 606 | \\ irule part_in_partition 607 | \\ metis_tac[SUBSET_DEF] 608 | QED 609 | 610 | Theorem restrict_partition_common_refinement: 611 | (!v. v IN sop ==> v partitions w) ∧ e ⊆ w ⇒ 612 | restrict_partition (common_refinement w sop) e = 613 | common_refinement e (IMAGE (\v. restrict_partition v e) sop) 614 | Proof 615 | strip_tac 616 | \\ Cases_on`sop = {}` \\ gs[] 617 | >- ( 618 | simp[common_refinement_empty] 619 | \\ irule restrict_indiscrete_partition 620 | \\ simp[] ) 621 | \\ DEP_REWRITE_TAC[common_refinement_BIGINTER] 622 | \\ simp[PULL_EXISTS] 623 | \\ conj_tac >- metis_tac[restrict_partition_partitions] 624 | \\ rw[restrict_partition_def] 625 | \\ irule IMAGE_CONG 626 | \\ simp[] 627 | \\ qx_gen_tac`x` \\ strip_tac 628 | \\ simp[GSYM IMAGE_COMPOSE, combinTheory.o_DEF] 629 | \\ gs[GSYM restrict_partition_def] 630 | \\ simp[Once INTER_COMM] 631 | \\ qmatch_goalsub_abbrev_tac`part iv x` 632 | \\ simp[Once EXTENSION, PULL_EXISTS] 633 | \\ qx_gen_tac`y` 634 | \\ Cases_on`y ∈ e` \\ simp[] 635 | \\ gs[GSYM common_refinement_BIGINTER] 636 | \\ `iv partitions w` by metis_tac[common_refinement_partitions] 637 | \\ `∀v. v ∈ sop ⇒ iv refines v` by metis_tac[common_refinement_refines] 638 | \\ `x ∈ w ∧ y ∈ w` by metis_tac[SUBSET_DEF] 639 | \\ `∀v. v ∈ sop ∧ part iv x = part iv y ⇒ part v x = part v y` 640 | by metis_tac[refines_grows_parts] 641 | \\ `y ∈ part iv x <=> (part iv x = part iv y)` 642 | by ( 643 | reverse(rw[EQ_IMP_THM]) 644 | >- metis_tac[in_part] 645 | \\ irule part_unique 646 | \\ metis_tac[part_in_partition]) 647 | \\ pop_assum SUBST1_TAC 648 | \\ eq_tac >> rw[] 649 | >- ( 650 | DEP_REWRITE_TAC[part_restrict_partition] 651 | \\ rw[] \\ metis_tac[in_part] ) 652 | \\ qunabbrev_tac`iv` 653 | \\ DEP_REWRITE_TAC[same_part_common_refinement_iff] 654 | \\ rw[] 655 | \\ first_x_assum drule 656 | \\ DEP_REWRITE_TAC[part_restrict_partition] 657 | \\ rw[] 658 | \\ irule part_unique 659 | \\ metis_tac[part_in_partition] 660 | QED 661 | 662 | Theorem restrict_restrict_partition: 663 | v partitions w ∧ s2 ⊆ s1 ∧ s1 ⊆ w ⇒ 664 | restrict_partition (restrict_partition v s1) s2 = 665 | restrict_partition v s2 666 | Proof 667 | rw[restrict_partition_def] 668 | \\ rw[Once EXTENSION] 669 | \\ rw[GSYM restrict_partition_def] 670 | \\ `restrict_partition v s1 partitions s1` by metis_tac[restrict_partition_partitions] 671 | \\ AP_TERM_TAC 672 | \\ simp[Once FUN_EQ_THM] 673 | \\ qx_gen_tac`s` 674 | \\ Cases_on`s ∈ s2` \\ simp[] 675 | \\ DEP_REWRITE_TAC[part_restrict_partition] 676 | \\ conj_tac >- metis_tac[SUBSET_DEF] 677 | \\ qmatch_goalsub_abbrev_tac`x = a <=> x = b` 678 | \\ `a = b` suffices_by rw[] 679 | \\ simp[Abbr`a`, Abbr`b`] 680 | \\ simp[Once EXTENSION] 681 | \\ metis_tac[SUBSET_DEF] 682 | QED 683 | 684 | Theorem pull_out_partition: 685 | v partitions w ∧ x PSUBSET w ⇒ 686 | w DIFF x INSERT restrict_partition v x partitions w 687 | Proof 688 | strip_tac 689 | \\ dsimp[restrict_partition_def, partitions_thm] 690 | \\ simp[GSYM CONJ_ASSOC] 691 | \\ simp[SUBSET_DIFF_EMPTY] 692 | \\ conj_asm1_tac >- metis_tac[SUBSET_ANTISYM, PSUBSET_DEF] 693 | \\ conj_asm1_tac 694 | >- ( 695 | simp[GSYM MEMBER_NOT_EMPTY] 696 | \\ qx_gen_tac`z` \\ strip_tac 697 | \\ qexists_tac`z` 698 | \\ metis_tac[in_part, PSUBSET_DEF, SUBSET_DEF]) 699 | \\ conj_asm1_tac 700 | >- metis_tac[PSUBSET_DEF, SUBSET_INTER_SUBSET, INTER_COMM] 701 | \\ rw[] 702 | \\ simp[EXISTS_UNIQUE_THM] 703 | \\ conj_tac 704 | >- ( 705 | qexists_tac`if y IN x then part v y INTER x else w DIFF x` 706 | \\ IF_CASES_TAC \\ simp[] 707 | \\ `y ∈ part v y` by metis_tac[in_part] 708 | \\ metis_tac[]) 709 | \\ rw[] \\ fs[] 710 | \\ `∀z. z ∈ x ⇒ z ∈ w` by metis_tac[PSUBSET_DEF, SUBSET_DEF] 711 | \\ metis_tac[part_unique, part_in_partition] 712 | QED 713 | 714 | Theorem binary_partition: 715 | x <> {} /\ x PSUBSET w ⇒ 716 | {x; w DIFF x} partitions w 717 | Proof 718 | rw[partitions_thm, PSUBSET_DEF] \\ rw[] 719 | >- ( 720 | gs[GSYM MEMBER_NOT_EMPTY] 721 | \\ metis_tac[SUBSET_DEF, SET_EQ_SUBSET]) 722 | \\ dsimp[EXISTS_UNIQUE_THM] 723 | \\ metis_tac[] 724 | QED 725 | 726 | Theorem restrict_partition_remove_disjoint: 727 | v partitions w ∧ e ⊆ w ∧ u partitions e ∧ 728 | u ⊆ v ∧ (∀x. x ∈ v ∧ x ∉ u ⇒ DISJOINT x e) ⇒ 729 | restrict_partition v e = restrict_partition u e 730 | Proof 731 | rw[restrict_partition_def] 732 | \\ simp[Once EXTENSION] 733 | \\ rw[EQ_IMP_THM] 734 | \\ goal_assum(first_assum o mp_then Any mp_tac) 735 | \\ qmatch_asmsub_rename_tac`x ∈ e` 736 | \\ `x ∈ w` by metis_tac[SUBSET_DEF] 737 | \\ `part v x ∈ v ∧ x ∈ part v x` by metis_tac[in_part, part_in_partition] 738 | \\ `part u x ∈ u ∧ x ∈ part u x` by metis_tac[in_part, part_in_partition] 739 | \\ (Cases_on`part v x ∈ u` 740 | >- ( `part v x = part u x` by metis_tac[part_unique] \\ gs[] )) 741 | \\ metis_tac[IN_DISJOINT] 742 | QED 743 | 744 | Theorem common_refinement_IMAGE_common_refinement: 745 | (∀sop. sop ∈ sosp ⇒ ∀v. v ∈ sop ⇒ v partitions w) ⇒ 746 | common_refinement w (IMAGE (common_refinement w) sosp) = 747 | common_refinement w (BIGUNION sosp) 748 | Proof 749 | strip_tac 750 | \\ DEP_REWRITE_TAC[common_refinement_BIGINTER] 751 | \\ simp[PULL_EXISTS, common_refinement_partitions] 752 | \\ conj_tac >- metis_tac[] 753 | \\ rw[Once EXTENSION, EQ_IMP_THM] 754 | \\ goal_assum(first_assum o mp_then Any mp_tac) 755 | \\ rw[Once EXTENSION, EQ_IMP_THM] \\ gs[PULL_EXISTS] 756 | \\ TRY ( 757 | qmatch_goalsub_rename_tac`x ∈ part (common_refinement w sop) z` 758 | \\ `part (common_refinement w sop) z = part (common_refinement w sop) x` 759 | by ( 760 | irule same_part_common_refinement 761 | \\ rw[] 762 | \\ irule part_unique 763 | \\ rw[] 764 | \\ metis_tac[part_in_partition] ) 765 | \\ rw[] 766 | \\ irule in_part 767 | \\ metis_tac[common_refinement_partitions]) 768 | \\ qmatch_goalsub_rename_tac`x ∈ part v y` 769 | \\ `part v y = part v x` suffices_by metis_tac[in_part] 770 | \\ `part (common_refinement w s) y = part (common_refinement w s) x` 771 | suffices_by metis_tac[same_part_common_refinement_iff] 772 | \\ irule part_unique 773 | \\ metis_tac[part_in_partition, common_refinement_partitions] 774 | QED 775 | 776 | Theorem restrict_partition_to_empty[simp]: 777 | restrict_partition v {} = {} 778 | Proof 779 | rw[restrict_partition_def] 780 | QED 781 | 782 | val _ = export_theory(); 783 | -------------------------------------------------------------------------------- /matrixLib.sml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright 2021 DeepMind Technologies Limited. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | https://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | *) 16 | 17 | structure matrixLib = struct 18 | local 19 | open HolKernel boolLib bossLib dep_rewrite 20 | ASCIInumbersLib listTheory rich_listTheory sortingTheory matrixTheory 21 | 22 | val SET_TO_LIST_tm = ``SET_TO_LIST`` 23 | 24 | fun qsort_set_to_list_conv1 tm = 25 | if listSyntax.is_cons tm andalso 26 | same_const SET_TO_LIST_tm (rator (#2(listSyntax.dest_cons tm))) 27 | then 28 | ONCE_REWRITE_CONV [CONS_APPEND] tm 29 | else if listSyntax.is_append tm andalso 30 | listSyntax.is_append (#2 (listSyntax.dest_append tm)) then 31 | (ONCE_REWRITE_CONV [APPEND_ASSOC] THENC 32 | LAND_CONV (SIMP_CONV (srw_ss()) [])) tm 33 | else raise UNCHANGED 34 | 35 | fun qsort_set_to_list_conv2 tm = 36 | if boolSyntax.is_cond tm then SIMP_CONV(srw_ss())[] tm 37 | else raise UNCHANGED 38 | 39 | in 40 | val () = computeLib.add_funs [relationTheory.RC_DEF] 41 | val qsort_set_to_list_tac = 42 | simp[QSORT_char_lt_SET_TO_LIST_init] 43 | \\ rpt (CHANGED_TAC ( 44 | CONV_TAC(DEPTH_CONV qsort_set_to_list_conv1) 45 | \\ DEP_REWRITE_TAC[QSORT_char_lt_SET_TO_LIST] 46 | \\ CONV_TAC(DEPTH_CONV qsort_set_to_list_conv2))) 47 | \\ simp[] 48 | end 49 | end 50 | -------------------------------------------------------------------------------- /matrixScript.sml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright 2021 DeepMind Technologies Limited. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | https://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | *) 16 | 17 | open HolKernel boolLib bossLib boolSimps Parse dep_rewrite 18 | sortingTheory pred_setTheory listTheory relationTheory stringTheory cf0Theory 19 | 20 | val _ = new_theory"matrix"; 21 | 22 | (* TODO: move *) 23 | Theorem GENLIST_EQ_NIL[simp]: (* already in helper_listTheory *) 24 | !n. GENLIST f n = [] <=> n = 0 25 | Proof 26 | Cases \\ rw[GENLIST] 27 | QED 28 | 29 | Theorem set_MAP_nub[simp]: 30 | set (MAP f (nub ls)) = set (MAP f ls) 31 | Proof 32 | rw[EXTENSION, MEM_MAP] 33 | QED 34 | (* -- *) 35 | 36 | Definition cf_matrix_def: 37 | cf_matrix c = 38 | MAP (λa. MAP (c.eval a) (QSORT (RC(SHORTLEX char_lt)) (SET_TO_LIST c.env))) 39 | (QSORT (RC(SHORTLEX char_lt)) (SET_TO_LIST c.agent)) 40 | End 41 | 42 | Theorem RC_SHORTLEX_char_lt_transitive[simp]: 43 | transitive (RC (SHORTLEX char_lt)) 44 | Proof 45 | irule transitive_RC 46 | \\ irule SHORTLEX_transitive 47 | \\ simp[transitive_def, char_lt_def] 48 | QED 49 | 50 | Theorem RC_SHORTLEX_char_lt_total[simp]: 51 | total (RC (SHORTLEX char_lt)) 52 | Proof 53 | irule SHORTLEX_total 54 | \\ simp[total_def, RC_DEF, char_lt_def] 55 | \\ Cases \\ Cases \\ simp[] 56 | QED 57 | 58 | Theorem RC_SHORTLEX_char_lt_antisymmetric[simp]: 59 | antisymmetric (RC (SHORTLEX char_lt)) 60 | Proof 61 | simp[antisymmetric_def] 62 | \\ Induct \\ simp[] 63 | \\ gen_tac \\ Cases \\ simp[] 64 | \\ rw[] \\ fs[] \\ rfs[char_lt_def] 65 | QED 66 | 67 | Theorem QSORT_char_lt_SET_TO_LIST: 68 | ∀x. 69 | (FINITE ls ⇒ 70 | QSORT (RC(SHORTLEX char_lt)) (x ++ SET_TO_LIST (s INSERT ls)) = 71 | QSORT (RC(SHORTLEX char_lt)) (x ++ if s ∈ ls then SET_TO_LIST ls else s::(SET_TO_LIST ls))) 72 | Proof 73 | gen_tac \\ simp[] 74 | \\ strip_tac 75 | \\ DEP_REWRITE_TAC[SORTS_PERM_EQ] 76 | \\ conj_tac 77 | >- ( simp[] \\ match_mp_tac QSORT_SORTS \\ simp[]) 78 | \\ simp[PERM_APPEND_IFF] 79 | \\ simp[PERM_SET_TO_LIST_INSERT] 80 | QED 81 | 82 | Theorem QSORT_char_lt_SET_TO_LIST_init = 83 | QSORT_char_lt_SET_TO_LIST |> Q.SPEC`[]` |> SIMP_RULE(srw_ss())[] 84 | 85 | Definition permute_rows_def: 86 | permute_rows f m = GENLIST (λn. EL (f n) m) (LENGTH m) 87 | End 88 | 89 | Definition permute_cols_def: 90 | permute_cols f m = MAP (λr. GENLIST (λn. EL (f n) r) (LENGTH r)) m 91 | End 92 | 93 | Theorem permute_rows_I[simp]: 94 | permute_rows I m = m 95 | Proof 96 | rw[permute_rows_def, LIST_EQ_REWRITE] 97 | QED 98 | 99 | Theorem permute_cols_I[simp]: 100 | permute_cols I m = m 101 | Proof 102 | rw[permute_cols_def, LIST_EQ_REWRITE, EL_MAP] 103 | QED 104 | 105 | Theorem permute_rows_cols_comm: 106 | (∀i. (i < LENGTH m) ⇒ pr i < LENGTH m) 107 | ⇒ 108 | permute_rows pr (permute_cols pc m) = 109 | permute_cols pc (permute_rows pr m) 110 | Proof 111 | rw[permute_rows_def, permute_cols_def] 112 | \\ simp[LIST_EQ_REWRITE] 113 | \\ rw[EL_MAP] 114 | QED 115 | 116 | Theorem LENGTH_permute_rows[simp]: 117 | LENGTH (permute_rows pr m) = LENGTH m 118 | Proof 119 | rw[permute_rows_def] 120 | QED 121 | 122 | Theorem LENGTH_permute_cols[simp]: 123 | LENGTH (permute_cols pc m) = LENGTH m 124 | Proof 125 | rw[permute_cols_def] 126 | QED 127 | 128 | Theorem EL_permute_rows[simp]: 129 | n < LENGTH m ⇒ 130 | EL n (permute_rows pr m) = EL (pr n) m 131 | Proof 132 | rw[permute_rows_def] 133 | QED 134 | 135 | Definition transpose_def: 136 | transpose m = 137 | GENLIST (λi. MAP (EL i) m) (LENGTH (HD m)) 138 | End 139 | 140 | Theorem set_MAP_LENGTH_cf_matrix[simp]: 141 | ¬NULL (cf_matrix c) ∧ FINITE c.env ⇒ 142 | set (MAP LENGTH (cf_matrix c)) = {CARD c.env} 143 | Proof 144 | rw[cf_matrix_def, LIST_TO_SET_MAP, GSYM IMAGE_COMPOSE, NULL_EQ] 145 | \\ rw[combinTheory.o_DEF] 146 | \\ rw[IMAGE_EQ_SING] 147 | \\ rw[SET_TO_LIST_CARD] 148 | QED 149 | 150 | Theorem SING_set_MAP_LENGTH_cf_matrix[simp]: 151 | ¬NULL (cf_matrix c) ⇒ 152 | SING (set (MAP LENGTH (cf_matrix c))) 153 | Proof 154 | rw[cf_matrix_def, LIST_TO_SET_MAP, GSYM IMAGE_COMPOSE, NULL_EQ] 155 | \\ rw[combinTheory.o_DEF, SING_DEF] 156 | \\ rw[IMAGE_EQ_SING] 157 | \\ qexists_tac`LENGTH (SET_TO_LIST c.env)` \\ rw[] 158 | QED 159 | 160 | Theorem transpose_idem[simp]: 161 | SING (set (MAP LENGTH m)) ∧ ¬ NULL (HD m) ⇒ 162 | transpose (transpose m) = m 163 | Proof 164 | rw[transpose_def, NULL_EQ] 165 | \\ Cases_on`HD m` \\ fs[HD_GENLIST] 166 | \\ simp[Once LIST_EQ_REWRITE] 167 | \\ rw[] 168 | \\ simp[MAP_GENLIST] 169 | \\ simp[Once LIST_EQ_REWRITE, EL_MAP] 170 | \\ fs[SING_DEF, EXTENSION, MEM_MAP] 171 | \\ `0 < LENGTH m` by simp[] 172 | \\ metis_tac[MEM_EL, EL, LENGTH] 173 | QED 174 | 175 | Theorem permute_cols_transpose: 176 | SING (set (MAP LENGTH m)) ∧ (∀i. i < LENGTH m ⇒ p i < LENGTH m) ⇒ 177 | permute_cols p (transpose m) = transpose (permute_rows p m) 178 | Proof 179 | rw[permute_cols_def, transpose_def, permute_rows_def] 180 | \\ simp[Once LIST_EQ_REWRITE] 181 | \\ conj_asm1_tac 182 | >- ( 183 | Cases_on`LENGTH m` \\ fs[HD_GENLIST] 184 | \\ fs[SING_DEF, EXTENSION, MEM_MAP, PULL_EXISTS] 185 | \\ `0 < LENGTH m` by simp[] 186 | \\ metis_tac[MEM_EL, EL] ) 187 | \\ pop_assum (assume_tac o SYM) 188 | \\ simp[EL_MAP] 189 | \\ simp[MAP_GENLIST] 190 | \\ simp[Once LIST_EQ_REWRITE] 191 | \\ simp[EL_MAP] 192 | QED 193 | 194 | Theorem distinct_rows_permute_set: 195 | ALL_DISTINCT m1 ∧ ALL_DISTINCT m2 ∧ LENGTH m1 = LENGTH m2 ⇒ 196 | ((∃p. p PERMUTES count (LENGTH m1) ∧ 197 | m1 = permute_rows p m2) ⇔ 198 | (set m1 = set m2)) 199 | Proof 200 | rw[EQ_IMP_THM] 201 | >- ( 202 | rw[EXTENSION] 203 | \\ rw[permute_rows_def, MEM_GENLIST] 204 | \\ rw[MEM_EL] 205 | \\ fs[BIJ_DEF, SURJ_DEF] 206 | \\ metis_tac[] ) 207 | \\ rw[Once LIST_EQ_REWRITE] 208 | \\ fs[EXTENSION] 209 | \\ rfs[MEM_EL] 210 | \\ qexists_tac`λi. @j. (j < LENGTH m2) ∧ EL i m1 = EL j m2` 211 | \\ fs[EL_ALL_DISTINCT_EL_EQ] 212 | \\ simp[BIJ_DEF, INJ_DEF, SURJ_DEF] 213 | \\ metis_tac[] 214 | QED 215 | 216 | Theorem ALL_DISTINCT_permute_cols: 217 | set (MAP LENGTH m) = {l} ∧ pc PERMUTES (count l) ⇒ 218 | (ALL_DISTINCT (permute_cols pc m) = ALL_DISTINCT m) 219 | Proof 220 | rw[EL_ALL_DISTINCT_EL_EQ, permute_cols_def, EL_MAP] 221 | \\ `∀n. (n < LENGTH m) ⇒ LENGTH (EL n m) = l` 222 | by ( 223 | fs[EXTENSION, MEM_MAP, PULL_EXISTS, MEM_EL] 224 | \\ metis_tac[] ) 225 | \\ rw[Once LIST_EQ_REWRITE] 226 | \\ fs[BIJ_DEF, INJ_DEF, SURJ_DEF] 227 | \\ rw[Once LIST_EQ_REWRITE] 228 | \\ metis_tac[] 229 | QED 230 | 231 | Theorem LENGTH_transpose_nub: 232 | SING (set (MAP LENGTH m)) ⇒ 233 | LENGTH (transpose (nub m)) = LENGTH (transpose m) 234 | Proof 235 | rw[transpose_def] 236 | \\ qmatch_goalsub_abbrev_tac`LENGTH (HD ls)` 237 | \\ `EVERY (λl. LENGTH l = LENGTH (HD m)) ls` 238 | by ( 239 | rw[Abbr`ls`, EVERY_MEM, MEM_GENLIST, PULL_EXISTS] 240 | \\ fs[SING_DEF, EXTENSION, MEM_MAP, MEM_EL] 241 | \\ `0 < LENGTH m` by simp[] 242 | \\ metis_tac[EL]) 243 | \\ Cases_on`ls` \\ fs[] 244 | QED 245 | 246 | Theorem set_MAP_LENGTH_transpose: 247 | ¬ NULL (HD m) ⇒ 248 | set (MAP LENGTH (transpose m)) = { LENGTH m } 249 | Proof 250 | rw[transpose_def, MAP_GENLIST, combinTheory.o_DEF] 251 | \\ simp[GSYM (SIMP_RULE std_ss [combinTheory.K_DEF] 252 | rich_listTheory.REPLICATE_GENLIST)] 253 | \\ simp[EXTENSION] 254 | \\ Cases_on`HD m` \\ fs[] 255 | QED 256 | 257 | Theorem LENGTH_transpose_nub_transpose: 258 | SING (set (MAP LENGTH m)) ∧ ¬NULL(HD m) ⇒ 259 | LENGTH (transpose (nub (transpose m))) = LENGTH m 260 | Proof 261 | strip_tac 262 | \\ DEP_REWRITE_TAC[LENGTH_transpose_nub] 263 | \\ DEP_REWRITE_TAC[transpose_idem] 264 | \\ DEP_REWRITE_TAC[set_MAP_LENGTH_transpose] 265 | \\ simp[] 266 | QED 267 | 268 | Theorem ALL_DISTINCT_transpose_nub_transpose: 269 | SING (set (MAP LENGTH m)) ∧ ¬ NULL (HD m) ⇒ 270 | (ALL_DISTINCT (transpose (nub (transpose m))) ⇔ 271 | ALL_DISTINCT m) 272 | Proof 273 | strip_tac 274 | \\ imp_res_tac LENGTH_transpose_nub_transpose 275 | \\ fs[transpose_def] 276 | \\ rw[ALL_DISTINCT_GENLIST] 277 | \\ simp[MAP_EQ_f] 278 | \\ simp[MEM_GENLIST, PULL_EXISTS] 279 | \\ `EVERY (λl. LENGTH l = LENGTH (HD m)) m` 280 | by ( 281 | fs[EVERY_MEM, SING_DEF, EXTENSION, MEM_MAP, PULL_EXISTS] 282 | \\ Cases_on`m` \\ fs[] 283 | \\ metis_tac[] ) 284 | \\ simp[EL_MAP, GSYM AND_IMP_INTRO] 285 | \\ simp[EL_ALL_DISTINCT_EL_EQ] 286 | \\ simp[Once LIST_EQ_REWRITE] 287 | \\ fs[EVERY_MEM, MEM_EL] 288 | \\ metis_tac[] 289 | QED 290 | 291 | Theorem EL_transpose_nub_eq: 292 | SING (set (MAP LENGTH m)) ∧ 293 | (n1 < LENGTH (transpose m)) ∧ (n2 < LENGTH (transpose m)) ⇒ 294 | (EL n1 (transpose (nub m)) = EL n2 (transpose (nub m)) ⇔ 295 | EL n1 (transpose m) = EL n2 (transpose m)) 296 | Proof 297 | rw[] 298 | \\ imp_res_tac LENGTH_transpose_nub 299 | \\ fs[transpose_def, EL_GENLIST] 300 | \\ simp[MAP_EQ_f] 301 | QED 302 | 303 | Theorem LENGTH_nub_transpose_nub: 304 | SING (set (MAP LENGTH m)) ⇒ 305 | LENGTH (nub (transpose (nub m))) = LENGTH (nub (transpose m)) 306 | Proof 307 | rw[GSYM CARD_LIST_TO_SET_EQN] 308 | \\ irule FINITE_BIJ_CARD 309 | \\ simp[] 310 | \\ imp_res_tac LENGTH_transpose_nub 311 | \\ qexists_tac`λc. EL (LEAST i. (i < LENGTH (transpose m)) ∧ 312 | (c = EL i (transpose (nub m)))) (transpose m)` 313 | \\ simp[BIJ_DEF, INJ_DEF, GSYM CONJ_ASSOC] 314 | \\ conj_asm1_tac 315 | >- ( 316 | rw[MEM_EL] 317 | \\ numLib.LEAST_ELIM_TAC 318 | \\ metis_tac[] ) 319 | \\ conj_tac 320 | >- ( 321 | simp[MEM_EL] 322 | \\ rpt gen_tac \\ strip_tac 323 | \\ numLib.LEAST_ELIM_TAC 324 | \\ numLib.LEAST_ELIM_TAC 325 | \\ rw[] 326 | >- metis_tac[] 327 | >- metis_tac[] 328 | \\ DEP_REWRITE_TAC[EL_transpose_nub_eq] 329 | \\ simp[] ) 330 | \\ rw[SURJ_DEF] 331 | \\ pop_assum mp_tac 332 | \\ rw[MEM_EL, PULL_EXISTS] 333 | \\ qexists_tac`n` \\ rw[] 334 | \\ numLib.LEAST_ELIM_TAC 335 | \\ metis_tac[EL_transpose_nub_eq] 336 | QED 337 | 338 | Theorem set_permute_rows: 339 | p PERMUTES count (LENGTH m) ⇒ 340 | set (permute_rows p m) = set m 341 | Proof 342 | rw[EXTENSION, permute_rows_def, MEM_GENLIST] 343 | \\ rw[MEM_EL] 344 | \\ fs[BIJ_IFF_INV] 345 | \\ metis_tac[] 346 | QED 347 | 348 | Theorem permute_cols_nub: 349 | set (MAP LENGTH m) = {l} ∧ p PERMUTES count l ⇒ 350 | permute_cols p (nub m) = nub (permute_cols p m) 351 | Proof 352 | rw[permute_cols_def] 353 | \\ DEP_REWRITE_TAC[nub_MAP_INJ] 354 | \\ rw[INJ_DEF] 355 | \\ fs[LIST_TO_SET_MAP, EXTENSION] 356 | \\ gs[LIST_EQ_REWRITE] 357 | \\ fs[BIJ_IFF_INV] 358 | \\ metis_tac[] 359 | QED 360 | 361 | Theorem permute_rows_compose: 362 | (∀x. (x < LENGTH ls) ⇒ p1 x < LENGTH ls) ⇒ 363 | permute_rows p1 (permute_rows p2 ls) = permute_rows (p2 o p1) ls 364 | Proof 365 | rw[permute_rows_def, LIST_EQ_REWRITE, EL_GENLIST] 366 | QED 367 | 368 | Theorem eq_rows_transpose_swap: 369 | set (MAP LENGTH m1) = {LENGTH m2} ∧ 370 | set (MAP LENGTH m2) = {LENGTH m1} ∧ 371 | ¬NULL (HD m1) ∧ ¬NULL (HD m2) ∧ 372 | ALL_DISTINCT m1 ∧ ALL_DISTINCT m2 ∧ 373 | ALL_DISTINCT (transpose m1) ∧ ALL_DISTINCT (transpose m2) 374 | ⇒ ( 375 | (∃p. p PERMUTES count (LENGTH m2) ∧ 376 | set m1 = set (transpose (permute_rows p m2))) ⇔ 377 | (∃p. p PERMUTES count (LENGTH m1) ∧ 378 | set (transpose m1) = set (permute_cols p m2)) ) 379 | Proof 380 | qho_match_abbrev_tac`P m1 m2 ⇒ (Q m1 m2 ⇔ R m1 m2)` 381 | \\ `∀m1 m2. P m1 m2 ∧ Q m1 m2 ⇒ R m1 m2` 382 | suffices_by ( 383 | rw[] 384 | \\ EQ_TAC >- metis_tac[] 385 | \\ `LENGTH (transpose m1) = LENGTH m2 ∧ 386 | LENGTH (transpose m2) = LENGTH m1` 387 | by ( 388 | rw[transpose_def, Abbr`P`] 389 | \\ Cases_on`m1` \\ gs[EXTENSION] 390 | \\ Cases_on`m2` \\ gs[EXTENSION] 391 | \\ metis_tac[] ) 392 | \\ `P (transpose m1) (transpose m2)` 393 | by ( 394 | fs[Abbr`P`, SING_DEF] 395 | \\ DEP_REWRITE_TAC[set_MAP_LENGTH_transpose] 396 | \\ simp[] 397 | \\ simp[transpose_def] 398 | \\ Cases_on`HD m1` \\ fs[] 399 | \\ Cases_on`HD m2` \\ fs[] 400 | \\ simp[GENLIST_CONS, NULL_EQ] 401 | \\ CCONTR_TAC \\ gs[] ) 402 | \\ strip_tac 403 | \\ `Q (transpose m1) (transpose m2)` 404 | by ( 405 | gs[Abbr`Q`, Abbr`R`, Abbr`P`] 406 | \\ qexists_tac`p` 407 | \\ conj_tac >- gs[] 408 | \\ DEP_REWRITE_TAC[GSYM permute_cols_transpose] 409 | \\ DEP_REWRITE_TAC[set_MAP_LENGTH_transpose] 410 | \\ gs[] 411 | \\ fs[BIJ_DEF, SURJ_DEF] ) 412 | \\ first_x_assum drule 413 | \\ simp[Abbr`R`] 414 | \\ DEP_REWRITE_TAC[transpose_idem] 415 | \\ conj_tac >- gs[Abbr`P`] 416 | \\ strip_tac 417 | \\ simp[Abbr`Q`] 418 | \\ qexists_tac`p` 419 | \\ DEP_REWRITE_TAC[permute_cols_transpose] 420 | \\ gs[Abbr`P`] 421 | \\ fs[BIJ_DEF, SURJ_DEF] ) 422 | \\ rw[Abbr`P`, Abbr`Q`, Abbr`R`] 423 | \\ `PERM m1 (transpose (permute_rows p m2))` by ( 424 | irule PERM_ALL_DISTINCT 425 | \\ rw[] 426 | \\ DEP_REWRITE_TAC[GSYM permute_cols_transpose] 427 | \\ DEP_REWRITE_TAC[Q.GEN`l`ALL_DISTINCT_permute_cols] 428 | \\ simp[] 429 | \\ DEP_REWRITE_TAC[set_MAP_LENGTH_transpose] 430 | \\ simp[] 431 | \\ fs[BIJ_DEF, SURJ_DEF] ) 432 | \\ fs[PERM_BIJ_IFF] 433 | \\ fs[GSYM permute_rows_def] 434 | \\ `∃p. p PERMUTES count (LENGTH m1) ∧ 435 | PERM (transpose m1) (permute_cols p m2)` 436 | suffices_by metis_tac[PERM_LIST_TO_SET] 437 | \\ simp[PERM_BIJ_IFF, PULL_EXISTS, GSYM permute_rows_def] 438 | \\ simp[Once transpose_def] 439 | \\ simp[Once transpose_def] 440 | \\ `LENGTH (HD m1) = LENGTH m2` 441 | by ( Cases_on`m1` \\ fs[EXTENSION] \\ metis_tac[] ) 442 | \\ simp[] 443 | \\ imp_res_tac BIJ_LINV_BIJ 444 | \\ goal_assum(first_assum o mp_then Any mp_tac) 445 | \\ goal_assum(first_assum o mp_then Any mp_tac) 446 | \\ qmatch_goalsub_abbrev_tac`permute_cols g'` 447 | \\ qmatch_goalsub_abbrev_tac`permute_rows g` 448 | \\ qpat_x_assum`_ = permute_rows _ _`mp_tac 449 | \\ simp[transpose_def, permute_rows_def, permute_cols_def] 450 | \\ simp[Once LIST_EQ_REWRITE, GSYM AND_IMP_INTRO] 451 | \\ strip_tac 452 | \\ simp[MAP_GENLIST] 453 | \\ disch_then(assume_tac o GSYM) 454 | \\ simp[Once LIST_EQ_REWRITE] 455 | \\ simp[EL_MAP] 456 | \\ rpt strip_tac 457 | \\ `g x < LENGTH m2` by fs[BIJ_DEF, SURJ_DEF] 458 | \\ simp[] 459 | \\ simp[Once LIST_EQ_REWRITE] 460 | \\ conj_asm1_tac 461 | >- ( rfs[EXTENSION,LIST_TO_SET_MAP,MEM_EL] \\ metis_tac[EL_MAP] ) 462 | \\ simp[EL_MAP] 463 | \\ rpt strip_tac 464 | \\ first_assum(qspec_then`g' x'`mp_tac) 465 | \\ impl_tac >- fs[BIJ_DEF, SURJ_DEF] 466 | \\ `p' (g' x') = x'` by metis_tac[BIJ_LINV_INV, IN_COUNT] 467 | \\ simp[] 468 | \\ metis_tac[BIJ_LINV_INV, IN_COUNT] 469 | QED 470 | 471 | val _ = export_theory(); 472 | --------------------------------------------------------------------------------