├── .github └── workflows │ ├── build-js.yml │ └── nix-action.yml ├── .gitignore ├── LICENSE ├── Makefile ├── Makefile.coq.local ├── README.md ├── Sudoku.css ├── Sudoku.html ├── SudokuBoard.js ├── _CoqProject ├── coq-sudoku-js.opam ├── coq-sudoku.opam ├── dune-project ├── index.html ├── meta.yml ├── src ├── Extract.v ├── dune ├── jSudoku.ml └── jSudoku.mli └── theories ├── Div.v ├── ListAux.v ├── ListOp.v ├── OrderedList.v ├── Parse.v ├── Permutation.v ├── Print.v ├── Sudoku.v ├── Tactic.v ├── Test.v ├── UList.v └── dune /.github/workflows/build-js.yml: -------------------------------------------------------------------------------- 1 | name: Build and Deploy JavaScript 2 | 3 | on: 4 | push: 5 | branches: 6 | - master 7 | pull_request: 8 | branches: 9 | - '**' 10 | 11 | jobs: 12 | build-js: 13 | runs-on: ubuntu-latest 14 | steps: 15 | - name: Set up Git repository 16 | uses: actions/checkout@v2 17 | 18 | - name: Build Sudoku JavaScript 19 | uses: coq-community/docker-coq-action@v1 20 | with: 21 | custom_image: 'coqorg/coq:dev-ocaml-4.13-flambda' 22 | custom_script: | 23 | {{before_install}} 24 | startGroup "Build sudoku dependencies" 25 | opam pin add -n -y -k path coq-sudoku . 26 | opam update -y 27 | opam install -y -j "$(nproc)" coq-sudoku --deps-only 28 | endGroup 29 | startGroup "Build sudoku" 30 | opam install -y -v -j "$(nproc)" coq-sudoku 31 | opam list 32 | endGroup 33 | startGroup "Build sudoku-js dependencies" 34 | opam pin add -n -y -k path coq-sudoku-js . 35 | opam update -y 36 | opam install -y -j "$(nproc)" coq-sudoku-js --deps-only 37 | endGroup 38 | startGroup "Build sudoku-js" 39 | opam install -y -v -j "$(nproc)" coq-sudoku-js 40 | opam list 41 | endGroup 42 | startGroup "Add permissions" 43 | sudo chown -R coq:coq . 44 | endGroup 45 | startGroup "Copy JavaScript" 46 | cp "$(opam var share)"/coq-sudoku-js/Sudoku.js . 47 | endGroup 48 | 49 | - name: Revert Coq user permissions 50 | # to avoid a warning at cleanup time 51 | if: ${{ always() }} 52 | run: sudo chown -R 1001:116 . 53 | 54 | - name: Copy HTML and CSS and JavaScript 55 | run: | 56 | mkdir public 57 | cp index.html SudokuBoard.js Sudoku.css Sudoku.html Sudoku.js public/ 58 | 59 | - name: Deploy to GitHub pages 60 | if: github.event_name == 'push' && github.ref == 'refs/heads/master' 61 | uses: crazy-max/ghaction-github-pages@v2 62 | with: 63 | build_dir: public 64 | jekyll: false 65 | env: 66 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 67 | -------------------------------------------------------------------------------- /.github/workflows/nix-action.yml: -------------------------------------------------------------------------------- 1 | # This file was generated from `meta.yml`, please do not edit manually. 2 | # Follow the instructions on https://github.com/coq-community/templates to regenerate. 3 | name: Nix CI 4 | 5 | on: 6 | push: 7 | branches: 8 | - master 9 | pull_request: 10 | paths: 11 | - .github/workflows/** 12 | pull_request_target: 13 | 14 | jobs: 15 | build: 16 | runs-on: ubuntu-latest 17 | strategy: 18 | matrix: 19 | overrides: 20 | - 'coq = "master"' 21 | - 'coq = "8.16"' 22 | - 'coq = "8.15"' 23 | - 'coq = "8.14"' 24 | - 'coq = "8.13"' 25 | - 'coq = "8.12"' 26 | fail-fast: false 27 | steps: 28 | - name: Determine which commit to test 29 | run: | 30 | if [[ ${{ github.event_name }} =~ "pull_request" ]]; then 31 | merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1) 32 | if [ -z "$merge_commit" ]; then 33 | echo "tested_commit=${{ github.event.pull_request.head.sha }}" >> $GITHUB_ENV 34 | else 35 | echo "tested_commit=$merge_commit" >> $GITHUB_ENV 36 | fi 37 | else 38 | echo "tested_commit=${{ github.sha }}" >> $GITHUB_ENV 39 | fi 40 | - uses: cachix/install-nix-action@v16 41 | with: 42 | nix_path: nixpkgs=channel:nixpkgs-unstable 43 | - uses: cachix/cachix-action@v10 44 | with: 45 | name: coq-community 46 | authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}' 47 | extraPullNames: coq, math-comp 48 | - uses: actions/checkout@v2 49 | with: 50 | ref: ${{ env.tested_commit }} 51 | - run: > 52 | nix-build https://coq.inria.fr/nix/toolbox --argstr job sudoku --arg override '{ ${{ matrix.overrides }}; sudoku = builtins.filterSource (path: _: baseNameOf path != ".git") ./.; }' 53 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.aux 2 | *.vok 3 | *.vos 4 | *.vo 5 | *.glob 6 | *.cache 7 | *.cmi 8 | *.cmo 9 | *.bytes 10 | .Makefile.coq.d 11 | .coqdeps.d 12 | .direnv 13 | Makefile.coq 14 | Makefile.coq.conf 15 | Sudoku.ml 16 | Sudoku.mli 17 | Sudoku.js 18 | _build 19 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 2.1, February 1999 3 | 4 | Copyright (C) 1991, 1999 Free Software Foundation, Inc. 5 | 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | [This is the first released version of the Lesser GPL. It also counts 10 | as the successor of the GNU Library Public License, version 2, hence 11 | the version number 2.1.] 12 | 13 | Preamble 14 | 15 | The licenses for most software are designed to take away your 16 | freedom to share and change it. By contrast, the GNU General Public 17 | Licenses are intended to guarantee your freedom to share and change 18 | free software--to make sure the software is free for all its users. 19 | 20 | This license, the Lesser General Public License, applies to some 21 | specially designated software packages--typically libraries--of the 22 | Free Software Foundation and other authors who decide to use it. You 23 | can use it too, but we suggest you first think carefully about whether 24 | this license or the ordinary General Public License is the better 25 | strategy to use in any particular case, based on the explanations below. 26 | 27 | When we speak of free software, we are referring to freedom of use, 28 | not price. Our General Public Licenses are designed to make sure that 29 | you have the freedom to distribute copies of free software (and charge 30 | for this service if you wish); that you receive source code or can get 31 | it if you want it; that you can change the software and use pieces of 32 | it in new free programs; and that you are informed that you can do 33 | these things. 34 | 35 | To protect your rights, we need to make restrictions that forbid 36 | distributors to deny you these rights or to ask you to surrender these 37 | rights. These restrictions translate to certain responsibilities for 38 | you if you distribute copies of the library or if you modify it. 39 | 40 | For example, if you distribute copies of the library, whether gratis 41 | or for a fee, you must give the recipients all the rights that we gave 42 | you. You must make sure that they, too, receive or can get the source 43 | code. If you link other code with the library, you must provide 44 | complete object files to the recipients, so that they can relink them 45 | with the library after making changes to the library and recompiling 46 | it. And you must show them these terms so they know their rights. 47 | 48 | We protect your rights with a two-step method: (1) we copyright the 49 | library, and (2) we offer you this license, which gives you legal 50 | permission to copy, distribute and/or modify the library. 51 | 52 | To protect each distributor, we want to make it very clear that 53 | there is no warranty for the free library. Also, if the library is 54 | modified by someone else and passed on, the recipients should know 55 | that what they have is not the original version, so that the original 56 | author's reputation will not be affected by problems that might be 57 | introduced by others. 58 | 59 | Finally, software patents pose a constant threat to the existence of 60 | any free program. We wish to make sure that a company cannot 61 | effectively restrict the users of a free program by obtaining a 62 | restrictive license from a patent holder. Therefore, we insist that 63 | any patent license obtained for a version of the library must be 64 | consistent with the full freedom of use specified in this license. 65 | 66 | Most GNU software, including some libraries, is covered by the 67 | ordinary GNU General Public License. This license, the GNU Lesser 68 | General Public License, applies to certain designated libraries, and 69 | is quite different from the ordinary General Public License. We use 70 | this license for certain libraries in order to permit linking those 71 | libraries into non-free programs. 72 | 73 | When a program is linked with a library, whether statically or using 74 | a shared library, the combination of the two is legally speaking a 75 | combined work, a derivative of the original library. The ordinary 76 | General Public License therefore permits such linking only if the 77 | entire combination fits its criteria of freedom. The Lesser General 78 | Public License permits more lax criteria for linking other code with 79 | the library. 80 | 81 | We call this license the "Lesser" General Public License because it 82 | does Less to protect the user's freedom than the ordinary General 83 | Public License. It also provides other free software developers Less 84 | of an advantage over competing non-free programs. These disadvantages 85 | are the reason we use the ordinary General Public License for many 86 | libraries. However, the Lesser license provides advantages in certain 87 | special circumstances. 88 | 89 | For example, on rare occasions, there may be a special need to 90 | encourage the widest possible use of a certain library, so that it becomes 91 | a de-facto standard. To achieve this, non-free programs must be 92 | allowed to use the library. A more frequent case is that a free 93 | library does the same job as widely used non-free libraries. In this 94 | case, there is little to gain by limiting the free library to free 95 | software only, so we use the Lesser General Public License. 96 | 97 | In other cases, permission to use a particular library in non-free 98 | programs enables a greater number of people to use a large body of 99 | free software. For example, permission to use the GNU C Library in 100 | non-free programs enables many more people to use the whole GNU 101 | operating system, as well as its variant, the GNU/Linux operating 102 | system. 103 | 104 | Although the Lesser General Public License is Less protective of the 105 | users' freedom, it does ensure that the user of a program that is 106 | linked with the Library has the freedom and the wherewithal to run 107 | that program using a modified version of the Library. 108 | 109 | The precise terms and conditions for copying, distribution and 110 | modification follow. Pay close attention to the difference between a 111 | "work based on the library" and a "work that uses the library". The 112 | former contains code derived from the library, whereas the latter must 113 | be combined with the library in order to run. 114 | 115 | GNU LESSER GENERAL PUBLIC LICENSE 116 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 117 | 118 | 0. This License Agreement applies to any software library or other 119 | program which contains a notice placed by the copyright holder or 120 | other authorized party saying it may be distributed under the terms of 121 | this Lesser General Public License (also called "this License"). 122 | Each licensee is addressed as "you". 123 | 124 | A "library" means a collection of software functions and/or data 125 | prepared so as to be conveniently linked with application programs 126 | (which use some of those functions and data) to form executables. 127 | 128 | The "Library", below, refers to any such software library or work 129 | which has been distributed under these terms. A "work based on the 130 | Library" means either the Library or any derivative work under 131 | copyright law: that is to say, a work containing the Library or a 132 | portion of it, either verbatim or with modifications and/or translated 133 | straightforwardly into another language. (Hereinafter, translation is 134 | included without limitation in the term "modification".) 135 | 136 | "Source code" for a work means the preferred form of the work for 137 | making modifications to it. For a library, complete source code means 138 | all the source code for all modules it contains, plus any associated 139 | interface definition files, plus the scripts used to control compilation 140 | and installation of the library. 141 | 142 | Activities other than copying, distribution and modification are not 143 | covered by this License; they are outside its scope. The act of 144 | running a program using the Library is not restricted, and output from 145 | such a program is covered only if its contents constitute a work based 146 | on the Library (independent of the use of the Library in a tool for 147 | writing it). Whether that is true depends on what the Library does 148 | and what the program that uses the Library does. 149 | 150 | 1. You may copy and distribute verbatim copies of the Library's 151 | complete source code as you receive it, in any medium, provided that 152 | you conspicuously and appropriately publish on each copy an 153 | appropriate copyright notice and disclaimer of warranty; keep intact 154 | all the notices that refer to this License and to the absence of any 155 | warranty; and distribute a copy of this License along with the 156 | Library. 157 | 158 | You may charge a fee for the physical act of transferring a copy, 159 | and you may at your option offer warranty protection in exchange for a 160 | fee. 161 | 162 | 2. You may modify your copy or copies of the Library or any portion 163 | of it, thus forming a work based on the Library, and copy and 164 | distribute such modifications or work under the terms of Section 1 165 | above, provided that you also meet all of these conditions: 166 | 167 | a) The modified work must itself be a software library. 168 | 169 | b) You must cause the files modified to carry prominent notices 170 | stating that you changed the files and the date of any change. 171 | 172 | c) You must cause the whole of the work to be licensed at no 173 | charge to all third parties under the terms of this License. 174 | 175 | d) If a facility in the modified Library refers to a function or a 176 | table of data to be supplied by an application program that uses 177 | the facility, other than as an argument passed when the facility 178 | is invoked, then you must make a good faith effort to ensure that, 179 | in the event an application does not supply such function or 180 | table, the facility still operates, and performs whatever part of 181 | its purpose remains meaningful. 182 | 183 | (For example, a function in a library to compute square roots has 184 | a purpose that is entirely well-defined independent of the 185 | application. Therefore, Subsection 2d requires that any 186 | application-supplied function or table used by this function must 187 | be optional: if the application does not supply it, the square 188 | root function must still compute square roots.) 189 | 190 | These requirements apply to the modified work as a whole. If 191 | identifiable sections of that work are not derived from the Library, 192 | and can be reasonably considered independent and separate works in 193 | themselves, then this License, and its terms, do not apply to those 194 | sections when you distribute them as separate works. But when you 195 | distribute the same sections as part of a whole which is a work based 196 | on the Library, the distribution of the whole must be on the terms of 197 | this License, whose permissions for other licensees extend to the 198 | entire whole, and thus to each and every part regardless of who wrote 199 | it. 200 | 201 | Thus, it is not the intent of this section to claim rights or contest 202 | your rights to work written entirely by you; rather, the intent is to 203 | exercise the right to control the distribution of derivative or 204 | collective works based on the Library. 205 | 206 | In addition, mere aggregation of another work not based on the Library 207 | with the Library (or with a work based on the Library) on a volume of 208 | a storage or distribution medium does not bring the other work under 209 | the scope of this License. 210 | 211 | 3. You may opt to apply the terms of the ordinary GNU General Public 212 | License instead of this License to a given copy of the Library. To do 213 | this, you must alter all the notices that refer to this License, so 214 | that they refer to the ordinary GNU General Public License, version 2, 215 | instead of to this License. (If a newer version than version 2 of the 216 | ordinary GNU General Public License has appeared, then you can specify 217 | that version instead if you wish.) Do not make any other change in 218 | these notices. 219 | 220 | Once this change is made in a given copy, it is irreversible for 221 | that copy, so the ordinary GNU General Public License applies to all 222 | subsequent copies and derivative works made from that copy. 223 | 224 | This option is useful when you wish to copy part of the code of 225 | the Library into a program that is not a library. 226 | 227 | 4. You may copy and distribute the Library (or a portion or 228 | derivative of it, under Section 2) in object code or executable form 229 | under the terms of Sections 1 and 2 above provided that you accompany 230 | it with the complete corresponding machine-readable source code, which 231 | must be distributed under the terms of Sections 1 and 2 above on a 232 | medium customarily used for software interchange. 233 | 234 | If distribution of object code is made by offering access to copy 235 | from a designated place, then offering equivalent access to copy the 236 | source code from the same place satisfies the requirement to 237 | distribute the source code, even though third parties are not 238 | compelled to copy the source along with the object code. 239 | 240 | 5. A program that contains no derivative of any portion of the 241 | Library, but is designed to work with the Library by being compiled or 242 | linked with it, is called a "work that uses the Library". Such a 243 | work, in isolation, is not a derivative work of the Library, and 244 | therefore falls outside the scope of this License. 245 | 246 | However, linking a "work that uses the Library" with the Library 247 | creates an executable that is a derivative of the Library (because it 248 | contains portions of the Library), rather than a "work that uses the 249 | library". The executable is therefore covered by this License. 250 | Section 6 states terms for distribution of such executables. 251 | 252 | When a "work that uses the Library" uses material from a header file 253 | that is part of the Library, the object code for the work may be a 254 | derivative work of the Library even though the source code is not. 255 | Whether this is true is especially significant if the work can be 256 | linked without the Library, or if the work is itself a library. The 257 | threshold for this to be true is not precisely defined by law. 258 | 259 | If such an object file uses only numerical parameters, data 260 | structure layouts and accessors, and small macros and small inline 261 | functions (ten lines or less in length), then the use of the object 262 | file is unrestricted, regardless of whether it is legally a derivative 263 | work. (Executables containing this object code plus portions of the 264 | Library will still fall under Section 6.) 265 | 266 | Otherwise, if the work is a derivative of the Library, you may 267 | distribute the object code for the work under the terms of Section 6. 268 | Any executables containing that work also fall under Section 6, 269 | whether or not they are linked directly with the Library itself. 270 | 271 | 6. As an exception to the Sections above, you may also combine or 272 | link a "work that uses the Library" with the Library to produce a 273 | work containing portions of the Library, and distribute that work 274 | under terms of your choice, provided that the terms permit 275 | modification of the work for the customer's own use and reverse 276 | engineering for debugging such modifications. 277 | 278 | You must give prominent notice with each copy of the work that the 279 | Library is used in it and that the Library and its use are covered by 280 | this License. You must supply a copy of this License. If the work 281 | during execution displays copyright notices, you must include the 282 | copyright notice for the Library among them, as well as a reference 283 | directing the user to the copy of this License. Also, you must do one 284 | of these things: 285 | 286 | a) Accompany the work with the complete corresponding 287 | machine-readable source code for the Library including whatever 288 | changes were used in the work (which must be distributed under 289 | Sections 1 and 2 above); and, if the work is an executable linked 290 | with the Library, with the complete machine-readable "work that 291 | uses the Library", as object code and/or source code, so that the 292 | user can modify the Library and then relink to produce a modified 293 | executable containing the modified Library. (It is understood 294 | that the user who changes the contents of definitions files in the 295 | Library will not necessarily be able to recompile the application 296 | to use the modified definitions.) 297 | 298 | b) Use a suitable shared library mechanism for linking with the 299 | Library. A suitable mechanism is one that (1) uses at run time a 300 | copy of the library already present on the user's computer system, 301 | rather than copying library functions into the executable, and (2) 302 | will operate properly with a modified version of the library, if 303 | the user installs one, as long as the modified version is 304 | interface-compatible with the version that the work was made with. 305 | 306 | c) Accompany the work with a written offer, valid for at 307 | least three years, to give the same user the materials 308 | specified in Subsection 6a, above, for a charge no more 309 | than the cost of performing this distribution. 310 | 311 | d) If distribution of the work is made by offering access to copy 312 | from a designated place, offer equivalent access to copy the above 313 | specified materials from the same place. 314 | 315 | e) Verify that the user has already received a copy of these 316 | materials or that you have already sent this user a copy. 317 | 318 | For an executable, the required form of the "work that uses the 319 | Library" must include any data and utility programs needed for 320 | reproducing the executable from it. However, as a special exception, 321 | the materials to be distributed need not include anything that is 322 | normally distributed (in either source or binary form) with the major 323 | components (compiler, kernel, and so on) of the operating system on 324 | which the executable runs, unless that component itself accompanies 325 | the executable. 326 | 327 | It may happen that this requirement contradicts the license 328 | restrictions of other proprietary libraries that do not normally 329 | accompany the operating system. Such a contradiction means you cannot 330 | use both them and the Library together in an executable that you 331 | distribute. 332 | 333 | 7. You may place library facilities that are a work based on the 334 | Library side-by-side in a single library together with other library 335 | facilities not covered by this License, and distribute such a combined 336 | library, provided that the separate distribution of the work based on 337 | the Library and of the other library facilities is otherwise 338 | permitted, and provided that you do these two things: 339 | 340 | a) Accompany the combined library with a copy of the same work 341 | based on the Library, uncombined with any other library 342 | facilities. This must be distributed under the terms of the 343 | Sections above. 344 | 345 | b) Give prominent notice with the combined library of the fact 346 | that part of it is a work based on the Library, and explaining 347 | where to find the accompanying uncombined form of the same work. 348 | 349 | 8. You may not copy, modify, sublicense, link with, or distribute 350 | the Library except as expressly provided under this License. Any 351 | attempt otherwise to copy, modify, sublicense, link with, or 352 | distribute the Library is void, and will automatically terminate your 353 | rights under this License. However, parties who have received copies, 354 | or rights, from you under this License will not have their licenses 355 | terminated so long as such parties remain in full compliance. 356 | 357 | 9. You are not required to accept this License, since you have not 358 | signed it. However, nothing else grants you permission to modify or 359 | distribute the Library or its derivative works. These actions are 360 | prohibited by law if you do not accept this License. Therefore, by 361 | modifying or distributing the Library (or any work based on the 362 | Library), you indicate your acceptance of this License to do so, and 363 | all its terms and conditions for copying, distributing or modifying 364 | the Library or works based on it. 365 | 366 | 10. Each time you redistribute the Library (or any work based on the 367 | Library), the recipient automatically receives a license from the 368 | original licensor to copy, distribute, link with or modify the Library 369 | subject to these terms and conditions. You may not impose any further 370 | restrictions on the recipients' exercise of the rights granted herein. 371 | You are not responsible for enforcing compliance by third parties with 372 | this License. 373 | 374 | 11. If, as a consequence of a court judgment or allegation of patent 375 | infringement or for any other reason (not limited to patent issues), 376 | conditions are imposed on you (whether by court order, agreement or 377 | otherwise) that contradict the conditions of this License, they do not 378 | excuse you from the conditions of this License. If you cannot 379 | distribute so as to satisfy simultaneously your obligations under this 380 | License and any other pertinent obligations, then as a consequence you 381 | may not distribute the Library at all. For example, if a patent 382 | license would not permit royalty-free redistribution of the Library by 383 | all those who receive copies directly or indirectly through you, then 384 | the only way you could satisfy both it and this License would be to 385 | refrain entirely from distribution of the Library. 386 | 387 | If any portion of this section is held invalid or unenforceable under any 388 | particular circumstance, the balance of the section is intended to apply, 389 | and the section as a whole is intended to apply in other circumstances. 390 | 391 | It is not the purpose of this section to induce you to infringe any 392 | patents or other property right claims or to contest validity of any 393 | such claims; this section has the sole purpose of protecting the 394 | integrity of the free software distribution system which is 395 | implemented by public license practices. Many people have made 396 | generous contributions to the wide range of software distributed 397 | through that system in reliance on consistent application of that 398 | system; it is up to the author/donor to decide if he or she is willing 399 | to distribute software through any other system and a licensee cannot 400 | impose that choice. 401 | 402 | This section is intended to make thoroughly clear what is believed to 403 | be a consequence of the rest of this License. 404 | 405 | 12. If the distribution and/or use of the Library is restricted in 406 | certain countries either by patents or by copyrighted interfaces, the 407 | original copyright holder who places the Library under this License may add 408 | an explicit geographical distribution limitation excluding those countries, 409 | so that distribution is permitted only in or among countries not thus 410 | excluded. In such case, this License incorporates the limitation as if 411 | written in the body of this License. 412 | 413 | 13. The Free Software Foundation may publish revised and/or new 414 | versions of the Lesser General Public License from time to time. 415 | Such new versions will be similar in spirit to the present version, 416 | but may differ in detail to address new problems or concerns. 417 | 418 | Each version is given a distinguishing version number. If the Library 419 | specifies a version number of this License which applies to it and 420 | "any later version", you have the option of following the terms and 421 | conditions either of that version or of any later version published by 422 | the Free Software Foundation. If the Library does not specify a 423 | license version number, you may choose any version ever published by 424 | the Free Software Foundation. 425 | 426 | 14. If you wish to incorporate parts of the Library into other free 427 | programs whose distribution conditions are incompatible with these, 428 | write to the author to ask for permission. For software which is 429 | copyrighted by the Free Software Foundation, write to the Free 430 | Software Foundation; we sometimes make exceptions for this. Our 431 | decision will be guided by the two goals of preserving the free status 432 | of all derivatives of our free software and of promoting the sharing 433 | and reuse of software generally. 434 | 435 | NO WARRANTY 436 | 437 | 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO 438 | WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 439 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR 440 | OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY 441 | KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE 442 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 443 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 444 | LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME 445 | THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 446 | 447 | 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN 448 | WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY 449 | AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU 450 | FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR 451 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 452 | LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 453 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 454 | FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 455 | SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 456 | DAMAGES. 457 | 458 | END OF TERMS AND CONDITIONS 459 | 460 | How to Apply These Terms to Your New Libraries 461 | 462 | If you develop a new library, and you want it to be of the greatest 463 | possible use to the public, we recommend making it free software that 464 | everyone can redistribute and change. You can do so by permitting 465 | redistribution under these terms (or, alternatively, under the terms of the 466 | ordinary General Public License). 467 | 468 | To apply these terms, attach the following notices to the library. It is 469 | safest to attach them to the start of each source file to most effectively 470 | convey the exclusion of warranty; and each file should have at least the 471 | "copyright" line and a pointer to where the full notice is found. 472 | 473 | 474 | Copyright (C) 475 | 476 | This library is free software; you can redistribute it and/or 477 | modify it under the terms of the GNU Lesser General Public 478 | License as published by the Free Software Foundation; either 479 | version 2.1 of the License, or (at your option) any later version. 480 | 481 | This library is distributed in the hope that it will be useful, 482 | but WITHOUT ANY WARRANTY; without even the implied warranty of 483 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 484 | Lesser General Public License for more details. 485 | 486 | You should have received a copy of the GNU Lesser General Public 487 | License along with this library; if not, write to the Free Software 488 | Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 489 | 490 | Also add information on how to contact you by electronic and paper mail. 491 | 492 | You should also get your employer (if you work as a programmer) or your 493 | school, if any, to sign a "copyright disclaimer" for the library, if 494 | necessary. Here is a sample; alter the names: 495 | 496 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 497 | library `Frob' (a library for tweaking knobs) written by James Random Hacker. 498 | 499 | , 1 April 1990 500 | Ty Coon, President of Vice 501 | 502 | That's all there is to it! 503 | 504 | 505 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: Makefile.coq 2 | @+$(MAKE) -f Makefile.coq all 3 | 4 | clean: Makefile.coq 5 | @+$(MAKE) -f Makefile.coq cleanall 6 | @rm -f Makefile.coq Makefile.coq.conf 7 | 8 | Makefile.coq: _CoqProject 9 | $(COQBIN)coq_makefile -f _CoqProject -o Makefile.coq 10 | 11 | force _CoqProject Makefile: ; 12 | 13 | %: Makefile.coq force 14 | @+$(MAKE) -f Makefile.coq $@ 15 | 16 | .PHONY: all clean force 17 | -------------------------------------------------------------------------------- /Makefile.coq.local: -------------------------------------------------------------------------------- 1 | Sudoku.js: Sudoku.bytes 2 | js_of_ocaml Sudoku.bytes 3 | 4 | Sudoku.bytes: src/jSudoku.cmi src/jSudoku.ml Sudoku.ml Sudoku.cmi 5 | ocamlfind ocamlc -I src -package js_of_ocaml -package js_of_ocaml-ppx -linkpkg -o Sudoku.bytes Sudoku.ml src/jSudoku.ml 6 | 7 | src/jSudoku.cmi: src/jSudoku.ml Sudoku.cmi 8 | ocamlfind ocamlc src/jSudoku.mli 9 | 10 | Sudoku.cmi: Sudoku.mli 11 | ocamlfind ocamlc Sudoku.mli 12 | 13 | Sudoku.ml Sudoku.mli: src/Extract.v theories/Sudoku.vo 14 | $(COQC) $(COQDEBUG) $(COQFLAGS) $(COQLIBS) src/Extract.v 15 | 16 | clean:: 17 | $(HIDE)rm -f Sudoku.ml Sudoku.mli src/jSudoku.cmi src/jSudoku.cmo Sudoku.cmi Sudoku.cmo Sudoku.bytes Sudoku.js 18 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 5 | # Sudoku 6 | 7 | [![Docker CI][docker-action-shield]][docker-action-link] 8 | [![Nix CI][nix-action-shield]][nix-action-link] 9 | [![Contributing][contributing-shield]][contributing-link] 10 | [![Code of Conduct][conduct-shield]][conduct-link] 11 | [![Zulip][zulip-shield]][zulip-link] 12 | 13 | [docker-action-shield]: https://github.com/coq-community/sudoku/workflows/Docker%20CI/badge.svg?branch=master 14 | [docker-action-link]: https://github.com/coq-community/sudoku/actions?query=workflow:"Docker%20CI" 15 | 16 | [nix-action-shield]: https://github.com/coq-community/sudoku/workflows/Nix%20CI/badge.svg?branch=master 17 | [nix-action-link]: https://github.com/coq-community/sudoku/actions?query=workflow:"Nix%20CI" 18 | 19 | [contributing-shield]: https://img.shields.io/badge/contributions-welcome-%23f7931e.svg 20 | [contributing-link]: https://github.com/coq-community/manifesto/blob/master/CONTRIBUTING.md 21 | 22 | [conduct-shield]: https://img.shields.io/badge/%E2%9D%A4-code%20of%20conduct-%23f15a24.svg 23 | [conduct-link]: https://github.com/coq-community/manifesto/blob/master/CODE_OF_CONDUCT.md 24 | 25 | [zulip-shield]: https://img.shields.io/badge/chat-on%20zulip-%23c1272d.svg 26 | [zulip-link]: https://coq.zulipchat.com/#narrow/stream/237663-coq-community-devs.20.26.20users 27 | 28 | 29 | 30 | A formalisation of Sudoku in Coq. It implements a naive 31 | Davis-Putnam procedure to solve Sudokus. 32 | 33 | ## Meta 34 | 35 | - Author(s): 36 | - Laurent Théry (initial) 37 | - Coq-community maintainer(s): 38 | - Ben Siraphob ([**@siraben**](https://github.com/siraben)) 39 | - Laurent Théry ([**@thery**](https://github.com/thery)) 40 | - License: [GNU Lesser General Public License v2.1 or later](LICENSE) 41 | - Compatible Coq versions: 8.12 or later 42 | - Additional dependencies: none 43 | - Coq namespace: `Sudoku` 44 | - Related publication(s): 45 | - [Sudoku in Coq](https://hal.inria.fr/hal-03277886) 46 | 47 | ## Building and installation instructions 48 | 49 | The easiest way to install the latest released version of Sudoku 50 | is via [OPAM](https://opam.ocaml.org/doc/Install.html): 51 | 52 | ```shell 53 | opam repo add coq-released https://coq.inria.fr/opam/released 54 | opam install coq-sudoku 55 | ``` 56 | 57 | To instead build and install manually, do: 58 | 59 | ``` shell 60 | git clone https://github.com/coq-community/sudoku.git 61 | cd sudoku 62 | make # or make -j 63 | make install 64 | ``` 65 | 66 | 67 | ## Documentation 68 | 69 | A Sudoku is represented as a mono-dimensional list of natural 70 | numbers. Zeros are used to represent empty cells. For example, 71 | the 3x3 Sudoku: 72 | 73 | ``` 74 | ------------------------------------- 75 | | | | 8 | 1 | 6 | | 9 | | | 76 | ------------------------------------- 77 | | | | 4 | | 5 | | 2 | | | 78 | ------------------------------------- 79 | | 9 | 7 | | | | 8 | | 4 | 5 | 80 | ------------------------------------- 81 | | | | 5 | | | | | | 6 | 82 | ------------------------------------- 83 | | 8 | 9 | | | | | | 3 | 7 | 84 | ------------------------------------- 85 | | 1 | | | | | | 4 | | | 86 | ------------------------------------- 87 | | 3 | 6 | | 5 | | | | 8 | 4 | 88 | ------------------------------------- 89 | | | | 2 | | 7 | | 5 | | | 90 | ------------------------------------- 91 | | | | 7 | | 4 | 9 | 3 | | | 92 | ------------------------------------- 93 | ``` 94 | 95 | is represented as 96 | 97 | ```coq 98 | 0 :: 0 :: 8 :: 1 :: 6 :: 0 :: 9 :: 0 :: 0 :: 99 | 0 :: 0 :: 4 :: 0 :: 5 :: 0 :: 2 :: 0 :: 0 :: 100 | 9 :: 7 :: 0 :: 0 :: 0 :: 8 :: 0 :: 4 :: 5 :: 101 | 0 :: 0 :: 5 :: 0 :: 0 :: 0 :: 0 :: 0 :: 6 :: 102 | 8 :: 9 :: 0 :: 0 :: 0 :: 0 :: 0 :: 3 :: 7 :: 103 | 1 :: 0 :: 0 :: 0 :: 0 :: 0 :: 4 :: 0 :: 0 :: 104 | 3 :: 6 :: 0 :: 5 :: 0 :: 0 :: 0 :: 8 :: 4 :: 105 | 0 :: 0 :: 2 :: 0 :: 7 :: 0 :: 5 :: 0 :: 0 :: 106 | 0 :: 0 :: 7 :: 0 :: 4 :: 9 :: 3 :: 0 :: 0 :: nil 107 | ``` 108 | 109 | All functions are parametrized by the height and width of 110 | a Sudoku's subrectangles. For example, for a 3x3 Sudoku: 111 | ```coq 112 | sudoku 3 3: list nat -> Prop 113 | 114 | check 3 3: forall l, {sudoku 3 3 l} + {~ sudoku 3 3 l} 115 | 116 | find_one 3 3: list nat -> option (list nat) 117 | 118 | find_all 3 3: list nat -> list (list nat) 119 | ``` 120 | 121 | See `Test.v`. 122 | 123 | Corresponding correctness theorems are: 124 | ```coq 125 | find_one_correct 3 3 126 | : forall s, 127 | length s = 81 -> 128 | match find_one 3 3 s with 129 | | Some s1 => refine 3 3 s s1 /\ sudoku 3 3 s1 130 | | None => 131 | forall s, refine 3 3 s s1 -> ~ sudoku 3 3 s1 132 | end 133 | 134 | find_all_correct 3 3 135 | : forall s s1, refine 3 3 s s1 -> (sudoku 3 3 s1 <-> In s1 (find_all 3 3 s)) 136 | ``` 137 | 138 | See `Sudoku.v`. 139 | 140 | More about the formalisation can be found in a [note](https://hal.inria.fr/hal-03277886). 141 | 142 | The following files are included: 143 | - `ListOp.v` some basic functions on list 144 | - `Sudoku.v` main file 145 | - `Test.v` test file 146 | - `Tactic.v` contradict tactic 147 | - `Div.v` division and modulo for nat 148 | - `Permutation.v` permutation 149 | - `UList.v` unique list 150 | - `ListAux.v` auxillary facts on lists 151 | - `OrderedList.v` ordered list 152 | 153 | The Sudoku code can be extracted to JavaScript using 154 | [js_of_ocaml](https://github.com/ocsigen/js_of_ocaml): 155 | ```shell 156 | make Sudoku.js 157 | ``` 158 | Then, point your browser at `Sudoku.html`. 159 | -------------------------------------------------------------------------------- /Sudoku.css: -------------------------------------------------------------------------------- 1 | #tic-tac-toe-board { 2 | display: block; 3 | margin: 0 auto; 4 | } 5 | 6 | .canvas-wrapper { 7 | position: absolute; 8 | top: 50%; 9 | transform: translateY(-50%); 10 | width: 100%; 11 | } 12 | 13 | .canvas-wrapper-parent { 14 | transform-style: preserver-3d; 15 | } 16 | -------------------------------------------------------------------------------- /Sudoku.html: -------------------------------------------------------------------------------- 1 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | Sudoku 16 | 17 | 18 | 19 |

Sudoku Solver

20 |

21 | This page lets you solve your Sudoku. The position is entered 22 | by clicking on the different squares of the Sudoku. For example, 23 | 5 is put on an empty square by clicking 24 | five times on it. Once the position is entered, click on 25 | the "Solve" button to solve it. If you want to start from 26 | scratch, click on the "Clear" button. 27 |

28 | 29 |

30 |

31 |
32 | 33 | 34 | 35 |
36 |
37 | 38 | 39 | 40 |
41 |
42 |

43 | 44 | This code has been proved correct in the Coq proof assistant. 45 | A paper that explains the algorithm that is used can 46 | be found here. We use js_of_ocaml to 47 | include OCaml code inside an HTML page. 48 | 49 | 50 | 51 | 52 | -------------------------------------------------------------------------------- /SudokuBoard.js: -------------------------------------------------------------------------------- 1 | /* This program is free software; you can redistribute it and/or */ 2 | /* modify it under the terms of the GNU Lesser General Public License */ 3 | /* as published by the Free Software Foundation; either version 2.1 */ 4 | /* of the License, or (at your option) any later version. */ 5 | /* */ 6 | /* This program is distributed in the hope that it will be useful, */ 7 | /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ 8 | /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ 9 | /* GNU General Public License for more details. */ 10 | /* */ 11 | /* You should have received a copy of the GNU Lesser General Public */ 12 | /* License along with this program; if not, write to the Free */ 13 | /* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA */ 14 | /* 02110-1301 USA */ 15 | 16 | 'use strict'; 17 | 18 | var player = 1; 19 | var lineColor = "#000"; 20 | 21 | var canvas = document.getElementById('sudokuBoard'); 22 | var context = canvas.getContext('2d'); 23 | var canvasSize = 300; 24 | var sectionSize = canvasSize / 9; 25 | canvas.width = canvasSize + canvasSize / 5; 26 | canvas.height = canvasSize + canvasSize / 5; 27 | var maxlinewidth = 4; 28 | context.translate(maxlinewidth, maxlinewidth); 29 | var message = document.getElementById('messageBoard'); 30 | 31 | function getInitialBoard(b, s) { 32 | for (var x = 0; x < 9; x++) { 33 | b.push([]); 34 | for (var y = 0; y < 9; y++) { 35 | b[x].push(Number.parseInt(s.charAt(x + 9 * y))); 36 | } 37 | } 38 | return; 39 | } 40 | 41 | var emptyText = "" 42 | var noText = "No solution " 43 | var oneText = "Exactly one solution " 44 | var twoText = "Two solutions at least" 45 | var init0 = '000000000000000000000000000000000000000000000000000000000000000000000000000000000'; 46 | var initS = '008160900004050200970008045005000006890000037100000400360500084002070500007049300'; 47 | var board = []; 48 | var board1 = []; 49 | var board2 = []; 50 | var fontS = "12px sans-serif"; 51 | var fontL = "20px sans-serif"; 52 | 53 | function addPlayingPiece(mouse) { 54 | var xCoordinate; 55 | var yCoordinate; 56 | 57 | for (var x = 0; x < 9; x++) { 58 | for (var y = 0; y < 9; y++) { 59 | xCoordinate = x * sectionSize; 60 | yCoordinate = y * sectionSize; 61 | 62 | if ( 63 | mouse.x >= xCoordinate && mouse.x <= xCoordinate + sectionSize && 64 | mouse.y >= yCoordinate && mouse.y <= yCoordinate + sectionSize 65 | ) { 66 | messageBoard.innerText = emptyText; 67 | clearPlayingArea(xCoordinate, yCoordinate); 68 | board[x][y] = (board[x][y] + 1) % 10; 69 | board1[x][y] = 0; 70 | board2[x][y] = 0; 71 | drawNumber(board[x][y], 0, 0, 72 | xCoordinate, yCoordinate); 73 | } 74 | } 75 | } 76 | 77 | } 78 | 79 | function clearPlayingArea(xCoordinate, yCoordinate) { 80 | context.fillStyle = "#fff"; 81 | context.fillRect( 82 | xCoordinate + maxlinewidth / 2, 83 | yCoordinate + maxlinewidth / 2, 84 | sectionSize - maxlinewidth, 85 | sectionSize - maxlinewidth 86 | ); 87 | } 88 | 89 | function drawNumber(v1, v2, v3, xCoordinate, yCoordinate) { 90 | context.fillStyle = "#000"; 91 | context.textAlign = 'center'; 92 | context.textBaseline = 'middle'; 93 | context.font = fontL; 94 | if (v1 != 0) { 95 | context.fillText(v1, xCoordinate + sectionSize / 2, 96 | yCoordinate + sectionSize / 2); 97 | } else { 98 | context.fillStyle = 'steelblue'; 99 | if (v2 != 0) { 100 | if ((v3 == 0) || (v2 == v3)) { 101 | context.fillText(v2, xCoordinate + sectionSize / 2, 102 | yCoordinate + sectionSize / 2); 103 | } else { 104 | context.font = fontS; 105 | context.fillText(v2, xCoordinate + (sectionSize) / 4, 106 | yCoordinate + (sectionSize) / 4); 107 | context.fillText(v3, xCoordinate + (3 * sectionSize) / 4, 108 | yCoordinate + (3 * sectionSize) / 4); 109 | } 110 | } 111 | } 112 | } 113 | 114 | function drawNumbers() { 115 | for (var x = 0; x < 9; x++) { 116 | for (var y = 0; y < 9; y++) { 117 | drawNumber(board[x][y], board1[x][y], board2[x][y], 118 | x * sectionSize, y * sectionSize); 119 | } 120 | } 121 | } 122 | 123 | function drawLines(lineWidth, strokeStyle, b) { 124 | var lineStart = 0; 125 | var lineLength = canvasSize; 126 | context.lineCap = "round"; 127 | context.lineWidth = lineWidth; 128 | context.strokeStyle = strokeStyle; 129 | context.beginPath(); 130 | 131 | /* 132 | * Horizontal lines 133 | */ 134 | for (var y = 0; y <= 9; y++) { 135 | if (b || (y % 3 == 0)) { 136 | context.moveTo(lineStart, 137 | y * sectionSize); 138 | context.lineTo(lineLength, 139 | y * sectionSize); 140 | } 141 | } 142 | 143 | /* 144 | * Vertical lines 145 | */ 146 | for (var x = 0; x <= 9; x++) { 147 | if (b || (x % 3 == 0)) { 148 | context.moveTo(x * sectionSize, 149 | lineStart); 150 | context.lineTo(x * sectionSize, 151 | lineLength); 152 | } 153 | } 154 | 155 | context.stroke(); 156 | } 157 | 158 | function resetBoard(s) { 159 | board = []; 160 | board1 = []; 161 | board2 = []; 162 | getInitialBoard(board, s); 163 | getInitialBoard(board1, init0); 164 | getInitialBoard(board2, init0); 165 | refreshBoard() 166 | } 167 | 168 | function refreshBoard() { 169 | if (typeof messageBoard != 'undefined') { 170 | messageBoard.innerText = emptyText 171 | } 172 | context.fillStyle = "#fff"; 173 | context.fillRect(0, 0, canvasSize, canvasSize); 174 | drawLines(maxlinewidth / 2, lineColor, true); 175 | drawLines(maxlinewidth, lineColor, false); 176 | drawNumbers() 177 | } 178 | 179 | function getStringBoard() { 180 | var res = '' 181 | for (var y = 0; y < 9; y++) { 182 | for (var x = 0; x < 9; x++) { 183 | res += board[x][y] 184 | } 185 | } 186 | return res; 187 | } 188 | 189 | function solveBoard() { 190 | var res = solve(getStringBoard()); 191 | board1 = []; 192 | board2 = []; 193 | getInitialBoard(board1, init0); 194 | getInitialBoard(board2, init0); 195 | if (res.charAt(0) == 'O') { 196 | res = res.substring(1, 82); 197 | board1 = []; 198 | getInitialBoard(board1, res); 199 | refreshBoard() 200 | messageBoard.innerText = oneText 201 | } else if (res.charAt(0) == 'N') { 202 | refreshBoard(); 203 | messageBoard.innerText = noText 204 | } else if (res.charAt(0) == 'M') { 205 | board1 = []; 206 | board2 = []; 207 | var res1 = res.substring(1, 82); 208 | var res2 = res.substring(83, 164); 209 | getInitialBoard(board1, res1); 210 | getInitialBoard(board2, res2); 211 | refreshBoard(); 212 | messageBoard.innerText = twoText 213 | } 214 | } 215 | 216 | var _ = resetBoard(initS, initS); 217 | 218 | function getCanvasMousePosition(event) { 219 | var rect = canvas.getBoundingClientRect(); 220 | 221 | return { 222 | x: event.clientX - rect.left, 223 | y: event.clientY - rect.top 224 | } 225 | } 226 | canvas.addEventListener('mouseup', function(event) { 227 | if (player === 1) { 228 | player = 2; 229 | } else { 230 | player = 1; 231 | } 232 | 233 | var canvasMousePosition = getCanvasMousePosition(event); 234 | addPlayingPiece(canvasMousePosition); 235 | drawLines(maxlinewidth / 2, lineColor, true); 236 | drawLines(maxlinewidth, lineColor, false); 237 | }); 238 | -------------------------------------------------------------------------------- /_CoqProject: -------------------------------------------------------------------------------- 1 | -R theories Sudoku 2 | 3 | theories/Div.v 4 | theories/ListAux.v 5 | theories/ListOp.v 6 | theories/OrderedList.v 7 | theories/Parse.v 8 | theories/Permutation.v 9 | theories/Print.v 10 | theories/Sudoku.v 11 | theories/Tactic.v 12 | theories/Test.v 13 | theories/UList.v 14 | src/Extract.v 15 | -------------------------------------------------------------------------------- /coq-sudoku-js.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "palmskog@gmail.com" 3 | version: "dev" 4 | 5 | homepage: "https://github.com/coq-community/sudoku" 6 | dev-repo: "git+https://github.com/coq-community/sudoku.git" 7 | bug-reports: "https://github.com/coq-community/sudoku/issues" 8 | license: "LGPL-2.1-or-later" 9 | 10 | synopsis: "JavaScript Sudoku solver certified in Coq" 11 | description: """ 12 | JavaScript Sudoku solver extracted from a formalisation 13 | in Coq using js_of_ocaml.""" 14 | 15 | build: ["dune" "build" "-p" name "-j" jobs] 16 | depends: [ 17 | "ocaml" {>= "4.11"} 18 | "dune" {>= "2.5"} 19 | "coq" {(>= "8.12" & < "8.15~") | (= "dev")} 20 | "js_of_ocaml" {>= "3.9.0"} 21 | "js_of_ocaml-ppx" 22 | "coq-sudoku" {= version} 23 | ] 24 | 25 | authors: [ 26 | "Laurent Théry" 27 | ] 28 | -------------------------------------------------------------------------------- /coq-sudoku.opam: -------------------------------------------------------------------------------- 1 | # This file was generated from `meta.yml`, please do not edit manually. 2 | # Follow the instructions on https://github.com/coq-community/templates to regenerate. 3 | 4 | opam-version: "2.0" 5 | maintainer: "palmskog@gmail.com" 6 | version: "dev" 7 | 8 | homepage: "https://github.com/coq-community/sudoku" 9 | dev-repo: "git+https://github.com/coq-community/sudoku.git" 10 | bug-reports: "https://github.com/coq-community/sudoku/issues" 11 | license: "LGPL-2.1-or-later" 12 | 13 | synopsis: "Sudoku solver certified in Coq" 14 | description: """ 15 | A formalisation of Sudoku in Coq. It implements a naive 16 | Davis-Putnam procedure to solve Sudokus.""" 17 | 18 | build: ["dune" "build" "-p" name "-j" jobs] 19 | depends: [ 20 | "dune" {>= "2.5"} 21 | "coq" {(>= "8.12" & < "8.15~") | (= "dev")} 22 | ] 23 | 24 | tags: [ 25 | "category:Miscellaneous/Logical Puzzles and Entertainment" 26 | "keyword:puzzles" 27 | "keyword:Davis-Putnam" 28 | "keyword:sudoku" 29 | "logpath:Sudoku" 30 | ] 31 | authors: [ 32 | "Laurent Théry" 33 | ] 34 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.5) 2 | (using coq 0.2) 3 | (name sudoku) 4 | -------------------------------------------------------------------------------- /index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Sudoku in Coq 4 | 5 | 6 | 7 | 8 | 9 | 10 | 15 | 20 | 21 | 22 | 23 | 24 |
25 |

Sudoku Solver in Coq

26 | 28 |
29 | 30 | 31 | 32 | 33 | 34 | -------------------------------------------------------------------------------- /meta.yml: -------------------------------------------------------------------------------- 1 | --- 2 | fullname: Sudoku 3 | shortname: sudoku 4 | organization: coq-community 5 | community: true 6 | action: true 7 | nix: true 8 | 9 | synopsis: Sudoku solver certified in Coq 10 | 11 | description: |- 12 | A formalisation of Sudoku in Coq. It implements a naive 13 | Davis-Putnam procedure to solve Sudokus. 14 | 15 | publications: 16 | - pub_url: https://hal.inria.fr/hal-03277886 17 | pub_title: Sudoku in Coq 18 | 19 | authors: 20 | - name: Laurent Théry 21 | initial: true 22 | 23 | maintainers: 24 | - name: Ben Siraphob 25 | nickname: siraben 26 | - name: Laurent Théry 27 | nickname: thery 28 | 29 | opam-file-maintainer: palmskog@gmail.com 30 | 31 | opam-file-version: dev 32 | 33 | license: 34 | fullname: GNU Lesser General Public License v2.1 or later 35 | identifier: LGPL-2.1-or-later 36 | 37 | supported_coq_versions: 38 | text: 8.12 or later 39 | opam: '{(>= "8.12" & < "8.15~") | (= "dev")}' 40 | 41 | tested_coq_opam_versions: 42 | - version: 'dev-ocaml-4.11-flambda' 43 | 44 | tested_coq_nix_versions: 45 | - coq_version: 'master' 46 | - coq_version: '8.14' 47 | - coq_version: '8.13' 48 | - coq_version: '8.12' 49 | 50 | namespace: Sudoku 51 | 52 | keywords: 53 | - name: puzzles 54 | - name: Davis-Putnam 55 | - name: sudoku 56 | 57 | categories: 58 | - name: Miscellaneous/Logical Puzzles and Entertainment 59 | 60 | documentation: |- 61 | ## Documentation 62 | 63 | A Sudoku is represented as a mono-dimensional list of natural 64 | numbers. Zeros are used to represent empty cells. For example, 65 | the 3x3 Sudoku: 66 | 67 | ``` 68 | ------------------------------------- 69 | | | | 8 | 1 | 6 | | 9 | | | 70 | ------------------------------------- 71 | | | | 4 | | 5 | | 2 | | | 72 | ------------------------------------- 73 | | 9 | 7 | | | | 8 | | 4 | 5 | 74 | ------------------------------------- 75 | | | | 5 | | | | | | 6 | 76 | ------------------------------------- 77 | | 8 | 9 | | | | | | 3 | 7 | 78 | ------------------------------------- 79 | | 1 | | | | | | 4 | | | 80 | ------------------------------------- 81 | | 3 | 6 | | 5 | | | | 8 | 4 | 82 | ------------------------------------- 83 | | | | 2 | | 7 | | 5 | | | 84 | ------------------------------------- 85 | | | | 7 | | 4 | 9 | 3 | | | 86 | ------------------------------------- 87 | ``` 88 | 89 | is represented as 90 | 91 | ```coq 92 | 0 :: 0 :: 8 :: 1 :: 6 :: 0 :: 9 :: 0 :: 0 :: 93 | 0 :: 0 :: 4 :: 0 :: 5 :: 0 :: 2 :: 0 :: 0 :: 94 | 9 :: 7 :: 0 :: 0 :: 0 :: 8 :: 0 :: 4 :: 5 :: 95 | 0 :: 0 :: 5 :: 0 :: 0 :: 0 :: 0 :: 0 :: 6 :: 96 | 8 :: 9 :: 0 :: 0 :: 0 :: 0 :: 0 :: 3 :: 7 :: 97 | 1 :: 0 :: 0 :: 0 :: 0 :: 0 :: 4 :: 0 :: 0 :: 98 | 3 :: 6 :: 0 :: 5 :: 0 :: 0 :: 0 :: 8 :: 4 :: 99 | 0 :: 0 :: 2 :: 0 :: 7 :: 0 :: 5 :: 0 :: 0 :: 100 | 0 :: 0 :: 7 :: 0 :: 4 :: 9 :: 3 :: 0 :: 0 :: nil 101 | ``` 102 | 103 | All functions are parametrized by the height and width of 104 | a Sudoku's subrectangles. For example, for a 3x3 Sudoku: 105 | ```coq 106 | sudoku 3 3: list nat -> Prop 107 | 108 | check 3 3: forall l, {sudoku 3 3 l} + {~ sudoku 3 3 l} 109 | 110 | find_one 3 3: list nat -> option (list nat) 111 | 112 | find_all 3 3: list nat -> list (list nat) 113 | ``` 114 | 115 | See `Test.v`. 116 | 117 | Corresponding correctness theorems are: 118 | ```coq 119 | find_one_correct 3 3 120 | : forall s, 121 | length s = 81 -> 122 | match find_one 3 3 s with 123 | | Some s1 => refine 3 3 s s1 /\ sudoku 3 3 s1 124 | | None => 125 | forall s, refine 3 3 s s1 -> ~ sudoku 3 3 s1 126 | end 127 | 128 | find_all_correct 3 3 129 | : forall s, 130 | length s = 81 -> 131 | refine 3 3 s s1 -> (sudoku 3 3 s1 <-> In s1 (find_all 3 3 s)) 132 | ``` 133 | 134 | See `Sudoku.v`. 135 | 136 | More about the formalisation can be found in a [note](https://hal.inria.fr/hal-03277886). 137 | 138 | The following files are included: 139 | - `ListOp.v` some basic functions on list 140 | - `Sudoku.v` main file 141 | - `Test.v` test file 142 | - `Tactic.v` contradict tactic 143 | - `Div.v` division and modulo for nat 144 | - `Permutation.v` permutation 145 | - `UList.v` unique list 146 | - `ListAux.v` auxillary facts on lists 147 | - `OrderedList.v` ordered list 148 | 149 | The Sudoku code can be extracted to JavaScript using 150 | [js_of_ocaml](https://github.com/ocsigen/js_of_ocaml): 151 | ```shell 152 | make Sudoku.js 153 | ``` 154 | Then, point your browser at `Sudoku.html`. 155 | --- 156 | -------------------------------------------------------------------------------- /src/Extract.v: -------------------------------------------------------------------------------- 1 | (* This program is free software; you can redistribute it and/or *) 2 | (* modify it under the terms of the GNU Lesser General Public License *) 3 | (* as published by the Free Software Foundation; either version 2.1 *) 4 | (* of the License, or (at your option) any later version. *) 5 | (* *) 6 | (* This program is distributed in the hope that it will be useful, *) 7 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 8 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 9 | (* GNU General Public License for more details. *) 10 | (* *) 11 | (* You should have received a copy of the GNU Lesser General Public *) 12 | (* License along with this program; if not, write to the Free *) 13 | (* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *) 14 | (* 02110-1301 USA *) 15 | 16 | From Sudoku Require Import Sudoku. 17 | From Coq Require Import Extraction. 18 | 19 | Extraction "Sudoku.ml" find_just_one. 20 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (coq.extraction 2 | (prelude Extract) 3 | (extracted_modules Sudoku) 4 | ;(theories Sudoku) 5 | ) 6 | 7 | (executable 8 | (name JSudoku) 9 | (modes js) 10 | (libraries js_of_ocaml) 11 | (preprocess (pps js_of_ocaml-ppx))) 12 | 13 | (install 14 | (section share) 15 | (files (JSudoku.bc.js as Sudoku.js)) 16 | (package coq-sudoku-js)) 17 | -------------------------------------------------------------------------------- /src/jSudoku.ml: -------------------------------------------------------------------------------- 1 | (* This program is free software; you can redistribute it and/or *) 2 | (* modify it under the terms of the GNU Lesser General Public License *) 3 | (* as published by the Free Software Foundation; either version 2.1 *) 4 | (* of the License, or (at your option) any later version. *) 5 | (* *) 6 | (* This program is distributed in the hope that it will be useful, *) 7 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 8 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 9 | (* GNU General Public License for more details. *) 10 | (* *) 11 | (* You should have received a copy of the GNU Lesser General Public *) 12 | (* License along with this program; if not, write to the Free *) 13 | (* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *) 14 | (* 02110-1301 USA *) 15 | 16 | (** link code **) 17 | 18 | open Js_of_ocaml 19 | open Sudoku 20 | 21 | let rec n2nat n = if n = 0 then O else S (n2nat (n - 1)) 22 | 23 | let rec nat2n n = match n with O -> 0 | S n -> 1 + (nat2n n) 24 | 25 | let string2l s = 26 | let le = String.length s in 27 | let rec iter i = if i = le then Nil else 28 | Cons (n2nat (Char.code (String.get s i) - 48), iter (i + 1)) in 29 | iter 0 30 | 31 | let rec l2stringr s l = 32 | match l with 33 | Nil -> s 34 | | Cons (n,l) -> l2stringr (s ^ (Char.escaped (Char.chr (nat2n n + 48)))) l 35 | 36 | let l2string l = l2stringr "" l 37 | 38 | let main s = 39 | let l = string2l s in 40 | match find_just_one (S (S (S O))) (S (S (S O))) l with 41 | | JNone -> "N" 42 | | JOne l -> "O" ^ (l2string l) 43 | | JMore (l1,l2) -> "M" ^ (l2string l1) ^ "M" ^ (l2string l2) 44 | 45 | let _ = 46 | Js.export_all 47 | (object%js 48 | method solve s = Js.string (main (Js.to_string s)) 49 | end) 50 | -------------------------------------------------------------------------------- /src/jSudoku.mli: -------------------------------------------------------------------------------- 1 | (* This program is free software; you can redistribute it and/or *) 2 | (* modify it under the terms of the GNU Lesser General Public License *) 3 | (* as published by the Free Software Foundation; either version 2.1 *) 4 | (* of the License, or (at your option) any later version. *) 5 | (* *) 6 | (* This program is distributed in the hope that it will be useful, *) 7 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 8 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 9 | (* GNU General Public License for more details. *) 10 | (* *) 11 | (* You should have received a copy of the GNU Lesser General Public *) 12 | (* License along with this program; if not, write to the Free *) 13 | (* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *) 14 | (* 02110-1301 USA *) 15 | 16 | open Sudoku 17 | 18 | val n2nat : int -> nat 19 | val nat2n : nat -> int 20 | val string2l : string -> nat list 21 | val l2stringr : string -> nat list -> string 22 | val l2string : nat list -> string 23 | val main : string -> string 24 | -------------------------------------------------------------------------------- /theories/Div.v: -------------------------------------------------------------------------------- 1 | (* This program is free software; you can redistribute it and/or *) 2 | (* modify it under the terms of the GNU Lesser General Public License *) 3 | (* as published by the Free Software Foundation; either version 2.1 *) 4 | (* of the License, or (at your option) any later version. *) 5 | (* *) 6 | (* This program is distributed in the hope that it will be useful, *) 7 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 8 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 9 | (* GNU General Public License for more details. *) 10 | (* *) 11 | (* You should have received a copy of the GNU Lesser General Public *) 12 | (* License along with this program; if not, write to the Free *) 13 | (* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *) 14 | (* 02110-1301 USA *) 15 | 16 | 17 | (******************************************************************************) 18 | (* Div.v *) 19 | (* *) 20 | (* Definitions: div mod *) 21 | (* *) 22 | (* *) 23 | (* Laurent.Thery@inria.fr (2006) *) 24 | (******************************************************************************) 25 | 26 | Require Import Arith. 27 | Require Import Tactic. 28 | Require Import Psatz. 29 | 30 | Notation "'div'" := Nat.div. 31 | Notation "'mod'" := Nat.modulo. 32 | 33 | Theorem div_mod_correct: forall n m, 0 < m -> n = div n m * m + mod n m. 34 | Proof. intros n m H; rewrite Nat.mul_comm; apply Nat.div_mod; lia. Qed. 35 | 36 | Theorem mod_lt: forall n m, 0 < m -> mod n m < m. 37 | Proof. intros n m H; apply Nat.mod_upper_bound; lia. Qed. 38 | 39 | Theorem div_lt: forall a b c, a < b * c -> div a b < c. 40 | Proof. intros a b c H; apply Nat.div_lt_upper_bound; lia. Qed. 41 | 42 | Theorem div_is_0: forall n m, n < m -> div n m = 0. 43 | Proof. intros; now apply Nat.div_small. Qed. 44 | 45 | Theorem mult_lt_plus: forall a b c d, a < b -> c < d -> a * d + c < b * d. 46 | Proof. nia. Qed. 47 | 48 | Theorem lexico_mult: forall a1 a2 b c1 c2, 49 | c1 < b -> c2 < b -> a1 * b + c1 = a2 * b + c2 -> a1 = a2. 50 | Proof. nia. Qed. 51 | 52 | Theorem div_mult_comp: forall n m p, 0 < p -> div (p * m + n) p = m + div n p. 53 | Proof. 54 | intros n m p H0. 55 | apply lexico_mult with (b := p) (c1 := mod (p * m + n) p) (c2 := mod n p); 56 | try apply mod_lt; auto with arith. 57 | rewrite Nat.mul_add_distr_r, <- Nat.add_assoc; 58 | repeat rewrite <- div_mod_correct; auto with arith. 59 | Qed. 60 | 61 | Theorem mod_small: forall n m, n < m -> mod n m = n. 62 | Proof. now intros; apply Nat.mod_small. Qed. 63 | 64 | Theorem mod_mult_comp: forall n m p, 0 < p -> mod (p * m + n) p = mod n p. 65 | Proof. 66 | intros n m p H; apply Nat.add_cancel_l with (div (p * m + n) p * p). 67 | rewrite <- div_mod_correct, div_mult_comp, Nat.mul_add_distr_r, (Nat.mul_comm p), <- Nat.add_assoc by assumption. 68 | f_equal. now apply div_mod_correct. 69 | Qed. 70 | -------------------------------------------------------------------------------- /theories/ListAux.v: -------------------------------------------------------------------------------- 1 | (* This program is free software; you can redistribute it and/or *) 2 | (* modify it under the terms of the GNU Lesser General Public License *) 3 | (* as published by the Free Software Foundation; either version 2.1 *) 4 | (* of the License, or (at your option) any later version. *) 5 | (* *) 6 | (* This program is distributed in the hope that it will be useful, *) 7 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 8 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 9 | (* GNU General Public License for more details. *) 10 | (* *) 11 | (* You should have received a copy of the GNU Lesser General Public *) 12 | (* License along with this program; if not, write to the Free *) 13 | (* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *) 14 | (* 02110-1301 USA *) 15 | 16 | 17 | (******************************************************************************) 18 | (* Aux.v *) 19 | (* *) 20 | (* Auxiliary functions & theorems for lists *) 21 | (* *) 22 | (* Laurent.Thery@inria.fr (2006) *) 23 | (******************************************************************************) 24 | Require Export List. 25 | Require Export Arith. 26 | Require Export Tactic. 27 | Require Import Inverse_Image. 28 | Require Import Wf_nat. 29 | 30 | (******************************************************************************) 31 | (* Some properties on list operators: app, map,... *) 32 | (******************************************************************************) 33 | 34 | Section List. 35 | Variables (A : Set) (B : Set) (C : Set). 36 | Variable f : A -> B. 37 | 38 | (******************************************************************************) 39 | (* An induction theorem for list based on length *) 40 | (******************************************************************************) 41 | 42 | Theorem list_length_ind: 43 | forall (P : list A -> Prop), 44 | (forall (l1 : list A), 45 | (forall (l2 : list A), length l2 < length l1 -> P l2) -> P l1) -> 46 | forall (l : list A), P l. 47 | Proof. 48 | intros P H l; 49 | apply well_founded_ind with (R := fun (x y : list A) => length x < length y); 50 | auto. 51 | apply wf_inverse_image with (R := lt); auto. 52 | apply lt_wf. 53 | Qed. 54 | 55 | Definition list_length_induction: 56 | forall (P : list A -> Set), 57 | (forall (l1 : list A), 58 | (forall (l2 : list A), length l2 < length l1 -> P l2) -> P l1) -> 59 | forall (l : list A), P l. 60 | Proof. 61 | intros P H l; 62 | apply well_founded_induction 63 | with (R := fun (x y : list A) => length x < length y); auto. 64 | apply wf_inverse_image with (R := lt); auto. 65 | apply lt_wf. 66 | Qed. 67 | 68 | Theorem in_ex_app: 69 | forall (a : A) (l : list A), 70 | In a l -> (exists l1 : list A , exists l2 : list A , l = l1 ++ (a :: l2)). 71 | Proof. 72 | intros a l; elim l; clear l; simpl; auto. 73 | intros H; case H. 74 | intros a1 l H [H1|H1]; auto. 75 | exists (nil (A:=A)); exists l; simpl; auto. 76 | f_equal; auto. 77 | case H; auto; intros l1 [l2 Hl2]; exists (a1 :: l1); exists l2; simpl; auto. 78 | f_equal; auto. 79 | Qed. 80 | 81 | (******************************************************************************) 82 | (* Properties of nth *) 83 | (******************************************************************************) 84 | 85 | Theorem nth_nil: forall n (a: A), nth n nil a = a. 86 | Proof. 87 | intros n; elim n; simpl; auto. 88 | Qed. 89 | 90 | Theorem in_ex_nth: forall (a b: A) l, 91 | In a l <-> exists n, n < length l /\ a = nth n l b. 92 | Proof. 93 | intros a b l. 94 | split; intros H. 95 | - pose proof (In_nth l a b H). 96 | destruct H0 as [n [H1 H2]]. 97 | exists n; auto. 98 | - destruct H as [n [H1 H2]]. 99 | pose proof (nth_In _ b H1); subst; auto. 100 | Qed. 101 | 102 | 103 | Theorem nth_app_l: forall i r (l1 l2: list A), 104 | i < length l1 -> nth i (l1 ++ l2) r = nth i l1 r. 105 | Proof. 106 | intros; apply app_nth1; auto. 107 | Qed. 108 | 109 | Theorem nth_app_r: forall i r (l1 l2: list A), 110 | length l1 <= i -> nth i (l1 ++ l2) r = nth (i - length l1) l2 r. 111 | Proof. 112 | intros; apply app_nth2; auto. 113 | Qed. 114 | 115 | Theorem nth_default: forall i r (l: list A), length l <= i -> nth i l r = r. 116 | Proof. 117 | intros; apply nth_overflow; auto. 118 | Qed. 119 | 120 | Theorem list_nth_eq: forall (r: A) l1 l2, 121 | length l1 = length l2 -> 122 | (forall n, nth n l1 r = nth n l2 r) -> l1 = l2. 123 | Proof. 124 | intros; eapply nth_ext; auto. 125 | Qed. 126 | 127 | (******************************************************************************) 128 | (* Properties on app *) 129 | (******************************************************************************) 130 | 131 | Theorem app_inv_app: 132 | forall l1 l2 l3 l4 a, 133 | l1 ++ l2 = l3 ++ (a :: l4) -> 134 | (exists l5 : list A , l1 = l3 ++ (a :: l5) ) \/ 135 | (exists l5 , l2 = l5 ++ (a :: l4) ). 136 | Proof. 137 | intros l1; elim l1; simpl; auto. 138 | intros l2 l3 l4 a H; right; exists l3; auto. 139 | intros a l H l2 l3 l4 a0; case l3; simpl. 140 | intros H0; left; exists l; f_equal; injection H0; auto. 141 | intros b l0 H0; case (H l2 l0 l4 a0); auto. 142 | injection H0; auto. 143 | intros [l5 H1]. 144 | left; exists l5; f_equal; injection H0; auto. 145 | Qed. 146 | 147 | Theorem app_inv_app2: 148 | forall l1 l2 l3 l4 a b, 149 | l1 ++ l2 = l3 ++ (a :: (b :: l4)) -> 150 | (exists l5 : list A , l1 = l3 ++ (a :: (b :: l5)) ) \/ 151 | ((exists l5 , l2 = l5 ++ (a :: (b :: l4)) ) \/ 152 | l1 = l3 ++ (a :: nil) /\ l2 = b :: l4). 153 | Proof. 154 | intros l1; elim l1; simpl; auto. 155 | intros l2 l3 l4 a b H; right; left; exists l3; auto. 156 | intros a l H l2 l3 l4 a0 b; case l3; simpl. 157 | case l; simpl. 158 | intros H0; right; right; injection H0; split; auto. 159 | f_equal; auto. 160 | intros b0 l0 H0; left; exists l0; injection H0; intros; (repeat f_equal); auto. 161 | intros b0 l0 H0; case (H l2 l0 l4 a0 b); auto. 162 | injection H0; auto. 163 | intros [l5 HH1]; left; exists l5; f_equal; auto; injection H0; auto. 164 | intros [H1|[H1 H2]]; auto. 165 | right; right; split; auto; f_equal; auto; injection H0; auto. 166 | Qed. 167 | 168 | Theorem same_length_ex: 169 | forall (a : A) l1 l2 l3, 170 | length (l1 ++ (a :: l2)) = length l3 -> 171 | (exists l4 , 172 | exists l5 , 173 | exists b : B , 174 | length l1 = length l4 /\ (length l2 = length l5 /\ l3 = l4 ++ (b :: l5))). 175 | Proof. 176 | intros a l1; elim l1; simpl; auto. 177 | intros l2 l3; case l3; simpl; (try (intros; discriminate)). 178 | intros b l H; exists (nil (A:=B)); exists l; exists b; (repeat (split; auto)). 179 | intros a0 l H l2 l3; case l3; simpl; (try (intros; discriminate)). 180 | intros b l0 H0. 181 | case (H l2 l0); auto. 182 | intros l4 [l5 [b1 [HH1 [HH2 HH3]]]]. 183 | exists (b :: l4); exists l5; exists b1; (repeat (simpl; split; auto)). 184 | f_equal; auto. 185 | Qed. 186 | 187 | (******************************************************************************) 188 | (* Properties on map *) 189 | (******************************************************************************) 190 | 191 | Theorem in_map_inv: 192 | forall (b : B) (l : list A), 193 | In b (map f l) -> (exists a : A , In a l /\ b = f a ). 194 | Proof. 195 | intros b l H. 196 | rewrite in_map_iff in H. 197 | destruct H as [x [H1 H2]]. 198 | eauto. 199 | Qed. 200 | 201 | Theorem in_map_fst_inv: 202 | forall a (l : list (B * C)), 203 | In a (map (fst (B:=_)) l) -> (exists c , In (a, c) l ). 204 | Proof. 205 | intros a l; elim l; simpl; auto. 206 | intros H; case H. 207 | intros a0 l0 H [H0|H0]; auto. 208 | exists (snd a0); left; rewrite <- H0; case a0; simpl; auto. 209 | case H; auto; intros l1 Hl1; exists l1; auto. 210 | Qed. 211 | 212 | Theorem length_map: forall l, length (map f l) = length l. 213 | Proof. 214 | apply map_length. 215 | Qed. 216 | 217 | Theorem map_length_decompose: 218 | forall l1 l2 l3 l4, 219 | length l1 = length l2 -> 220 | map f (app l1 l3) = app l2 l4 -> map f l1 = l2 /\ map f l3 = l4. 221 | Proof. 222 | intros l1; elim l1; simpl; auto; clear l1. 223 | intros l2; case l2; simpl; auto. 224 | intros; discriminate. 225 | intros a l1 Rec l2; case l2; simpl; clear l2; auto. 226 | intros; discriminate. 227 | intros b l2 l3 l4 H1 H2. 228 | injection H2; clear H2; intros H2 H3. 229 | case (Rec l2 l3 l4); auto. 230 | intros H4 H5; split; auto. 231 | f_equal; auto. 232 | Qed. 233 | 234 | (******************************************************************************) 235 | (* Properties of flat_map *) 236 | (******************************************************************************) 237 | 238 | Theorem in_flat_map: 239 | forall (l : list B) (f : B -> list C) a b, 240 | In a (f b) -> In b l -> In a (flat_map f l). 241 | Proof. 242 | intros l g; elim l; simpl; auto. 243 | intros a l0 H a0 b H0 [H1|H1]; apply in_or_app; auto. 244 | left; rewrite H1; auto. 245 | right; apply H with ( b := b ); auto. 246 | Qed. 247 | 248 | Theorem in_flat_map_ex: 249 | forall (l : list B) (f : B -> list C) a, 250 | In a (flat_map f l) -> (exists b , In b l /\ In a (f b) ). 251 | Proof. 252 | intros l g; elim l; simpl; auto. 253 | intros a H; case H. 254 | intros a l0 H a0 H0; case in_app_or with ( 1 := H0 ); simpl; auto. 255 | intros H1; exists a; auto. 256 | intros H1; case H with ( 1 := H1 ). 257 | intros b [H2 H3]; exists b; simpl; auto. 258 | Qed. 259 | 260 | End List. 261 | 262 | 263 | (******************************************************************************) 264 | (* Properties of list_prod *) 265 | (******************************************************************************) 266 | 267 | Theorem length_list_prod: 268 | forall (A : Set) (l1 l2 : list A), 269 | length (list_prod l1 l2) = length l1 * length l2. 270 | Proof. 271 | intros A l1 l2; elim l1; simpl; auto. 272 | intros a l H; rewrite app_length, length_map, H; auto. 273 | Qed. 274 | 275 | Theorem in_list_prod_inv: 276 | forall (A B : Set) a l1 l2, 277 | In a (list_prod l1 l2) -> 278 | (exists b : A , exists c : B , a = (b, c) /\ (In b l1 /\ In c l2) ). 279 | Proof. 280 | intros A B a l1 l2; elim l1; simpl; auto; clear l1. 281 | intros H; case H. 282 | intros a1 l1 H1 H2. 283 | case in_app_or with ( 1 := H2 ); intros H3; auto. 284 | case in_map_inv with ( 1 := H3 ); intros b1 [Hb1 Hb2]; auto. 285 | exists a1; exists b1; split; auto. 286 | case H1; auto; intros b1 [c1 [Hb1 [Hb2 Hb3]]]. 287 | exists b1; exists c1; split; auto. 288 | Qed. 289 | 290 | Definition In_dec: 291 | forall {A : Set}, 292 | (forall x y : A, {x = y} + {x <> y}) -> 293 | forall (a : A) (l : list A), {In a l} + {~ In a l}. 294 | Proof. 295 | intros A H a l. 296 | apply in_dec; auto. 297 | Defined. 298 | 299 | Definition In_dec1: 300 | forall {A: Set}, (forall x y : A, {x = y} + {x <> y}) -> 301 | forall (a : A) (l : list A), 302 | {ll : list A * list A| l = fst ll ++ (a :: snd ll)} + {~ In a l}. 303 | intros A dec; fix in_dec 2; intros a l; case l. 304 | right; simpl; intros tmp; case tmp. 305 | intros b l1; case (in_dec a l1); intros H. 306 | left; case H; intros ll HH; exists ((b :: fst ll), snd ll). 307 | rewrite HH; auto with datatypes. 308 | case (dec a b); intros H1. 309 | left; exists (@nil A, l1); subst; auto. 310 | right; simpl; intros [H2 | H2]; auto. 311 | Defined. 312 | 313 | Theorem in_fold_map: forall (A: Set) (f: nat -> nat -> A) p l1 l2, 314 | In p 315 | (fold_right 316 | (fun x l => 317 | map (f x) l1 ++ l) nil l2) <-> 318 | (exists x, (exists y , In x l2 /\ In y l1 /\ p = f x y)). 319 | Proof. 320 | intros A f p l1 l2; elim l2; simpl; auto; clear l2. 321 | split; auto. 322 | intros H; case H. 323 | intros (x, (y, (H, _))); auto. 324 | intros a l2 (Rec1, Rec2); split; intros H. 325 | case in_app_or with (1 := H); clear H; intros H. 326 | case (in_map_inv _ _ (f a) p l1); auto. 327 | intros y (H1, H2). 328 | exists a; exists y; repeat split; auto. 329 | case Rec1; auto; clear Rec1 Rec2. 330 | intros x (y, (U1, (U2, U3))); exists x; exists y; repeat split; 331 | auto with arith. 332 | case H; intros x (y, ([U1 | U1], (U2, U3))); subst; auto; clear H. 333 | apply in_or_app; left; auto. 334 | apply in_map; auto. 335 | apply in_or_app; right; auto. 336 | apply Rec2; auto; clear Rec1 Rec2. 337 | exists x; exists y; repeat split; auto with arith. 338 | Qed. 339 | -------------------------------------------------------------------------------- /theories/ListOp.v: -------------------------------------------------------------------------------- 1 | (* This program is free software; you can redistribute it and/or *) 2 | (* modify it under the terms of the GNU Lesser General Public License *) 3 | (* as published by the Free Software Foundation; either version 2.1 *) 4 | (* of the License, or (at your option) any later version. *) 5 | (* *) 6 | (* This program is distributed in the hope that it will be useful, *) 7 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 8 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 9 | (* GNU General Public License for more details. *) 10 | (* *) 11 | (* You should have received a copy of the GNU Lesser General Public *) 12 | (* License along with this program; if not, write to the Free *) 13 | (* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *) 14 | (* 02110-1301 USA *) 15 | 16 | 17 | (********************************************************) 18 | (* ListOp: *) 19 | (* Create the operations take, jump, take_and_jump *) 20 | (* these operations are used to represent rows columns *) 21 | (* and sub rectangles *) 22 | (* thery@sophia.inria.fr *) 23 | (* (2006) *) 24 | (********************************************************) 25 | Require Import List. 26 | Require Import ListAux. 27 | Require Import UList. 28 | Require Import OrderedList. 29 | 30 | Section list_op. 31 | 32 | Variable A: Set. 33 | Variable o: A. 34 | 35 | (* Take the first n elements of l *) 36 | Definition take n (l : list A) := firstn n l. 37 | Hint Unfold take : core. 38 | 39 | (* Taking for an empty list gives an empty list *) 40 | Theorem take_nil: forall n, take n nil = nil. 41 | Proof. 42 | apply firstn_nil. 43 | Qed. 44 | 45 | Theorem take_nth: forall i j r l, 46 | i < j \/ length l <= i -> nth i (take j l) r = nth i l r. 47 | Proof. 48 | intros i j r l; generalize i j r; elim l; simpl; auto with arith; 49 | clear i j r l. 50 | intros i j r; case i; auto; intros; rewrite take_nil; auto. 51 | intros a l Rec i j r; case i. 52 | case j; auto. 53 | intros [HH | HH]; contradict HH; auto with arith. 54 | intros n; case j; simpl; auto with arith. 55 | intros [HH | HH]. 56 | contradict HH; auto with arith. 57 | apply sym_equal; apply nth_default; auto with arith. 58 | intros n1 HH; apply Rec; case HH; auto with arith. 59 | Qed. 60 | 61 | Theorem length_take: forall i l, i <= length l -> length (take i l) = i. 62 | intros i l; generalize i; elim l; clear i l; simpl; auto. 63 | intros i; case i; auto. 64 | intros i1 HH; contradict HH; auto with arith. 65 | intros a l Rec i; case i; simpl; auto with arith. 66 | Qed. 67 | 68 | Theorem length_take_small: forall i l, length l <= i -> length (take i l) = length l. 69 | intros i l; generalize i; elim l; clear i l; simpl; auto. 70 | intros; rewrite take_nil; auto. 71 | intros a l Rec i; case i; simpl; auto with arith. 72 | Qed. 73 | 74 | Theorem length_take1: forall i s, 75 | i <= length s -> length (take i s) = i. 76 | Proof. 77 | intros i s H. 78 | apply firstn_length_le; auto. 79 | Qed. 80 | 81 | (* Jump the first n elements of l *) 82 | Definition jump (n: nat) (l: list A) := skipn n l. 83 | Hint Unfold jump : core. 84 | 85 | (* A jump on an empty list is an empty list *) 86 | Theorem jump_nil: forall n, jump n nil = nil. 87 | Proof. 88 | apply skipn_nil. 89 | Qed. 90 | 91 | (* the relation between jump and nth *) 92 | Theorem jump_nth: 93 | forall l k r, nth k l r = nth 0 (jump k l) r. 94 | intros l; elim l; simpl; auto. 95 | intros k r; rewrite jump_nil; simpl; case k; auto. 96 | intros a l1 Rec k r; case k; simpl; auto. 97 | Qed. 98 | 99 | (* If we jump too far we get nil *) 100 | Theorem jump_too_far: forall i l, length l <= i -> jump i l = nil. 101 | intros i l; generalize i; elim l; simpl; auto; clear i l. 102 | intros; apply jump_nil. 103 | intros a l Rec i; case i; simpl; auto with arith. 104 | intros H; contradict H; auto with arith. 105 | Qed. 106 | 107 | (* Jump is additive *) 108 | Theorem jump_add: forall a b l, jump (a + b) l = jump b (jump a l). 109 | Proof. 110 | intros a. 111 | induction a; auto; intros b l. 112 | - destruct l; simpl. 113 | + rewrite jump_nil. reflexivity. 114 | + apply IHa. 115 | Qed. 116 | 117 | Theorem length_jump: forall i s, 118 | i <= length s -> length s = length (jump i s) + i. 119 | Proof. 120 | intros i. 121 | induction i; auto; intros s H; simpl. 122 | - destruct s. 123 | + inversion H. 124 | + simpl. rewrite <- plus_n_Sm; auto with arith. 125 | Qed. 126 | 127 | (* Take from l t elements and then jump j elements n times *) 128 | Fixpoint take_and_jump (t j n: nat) (l: list A) {struct n}: list A := 129 | match n with 130 | 0 => nil 131 | | S n1 => take t l ++ take_and_jump t j n1 (jump j l) 132 | end. 133 | 134 | (* Taking and jumping on an empty list is an empty list *) 135 | Theorem take_and_jump_nil: forall a b c, 136 | take_and_jump a b c nil = nil. 137 | intros a b c; elim c; simpl; auto. 138 | intros n H; rewrite jump_nil, take_nil, H; auto with arith. 139 | Qed. 140 | 141 | Theorem length_take_and_jump: forall i j (k: nat) s, 142 | (if k then 0 else i) + pred k * j <= length s -> length (take_and_jump i j k s) = k * i. 143 | intros i j k; generalize i j; elim k; simpl; auto; clear i j k. 144 | intros k Rec i j s H; rewrite app_length, length_take1; 145 | auto with arith. 146 | f_equal; auto. 147 | apply Rec. 148 | generalize H; case k; clear k H Rec. 149 | intros; simpl; auto with arith. 150 | intros k H; simpl pred. 151 | apply Nat.add_le_mono_l with j. 152 | rewrite (fun x (y: list A) => Nat.add_comm x (length y)). 153 | rewrite <- length_jump; auto with arith. 154 | rewrite Nat.add_shuffle3; auto. 155 | apply Nat.le_trans with (2 := H); auto with arith. 156 | pattern j at 1; replace j with (0 + (j + 0)); auto with arith. 157 | apply Nat.add_le_mono; simpl; auto with arith. 158 | simpl; auto with arith. 159 | apply Nat.le_trans with (2 := H); auto with arith. 160 | Qed. 161 | 162 | (* Replace the n th element of the list l with the value v *) 163 | Fixpoint subst (n: nat) (v: A) (l: list A) {struct n} : list A := 164 | match l with 165 | nil => nil 166 | | a :: l1 => match n with O => v :: l1 | S n1 => a :: subst n1 v l1 end 167 | end. 168 | 169 | (* Subst does not change the length of a list *) 170 | Theorem length_subst: forall n v l, length (subst n v l) = length l. 171 | intros n; elim n; simpl; auto. 172 | intros v l; case l; simpl; auto. 173 | intros n1 Rec v l; case l; simpl; auto. 174 | Qed. 175 | 176 | 177 | (* Create a list of o of length n *) 178 | Fixpoint mk_0 (n: nat): list A := 179 | match n with O => nil | S n1 => o :: mk_0 n1 end. 180 | 181 | Theorem mk_0_length : forall n, length (mk_0 n) = n. 182 | intros n; elim n; simpl; auto. 183 | Qed. 184 | 185 | (* Replace all the element after the index n in the list l by o *) 186 | Fixpoint restrict (n: nat) (l: list A) {struct l}: list A := 187 | match l with 188 | nil => nil 189 | | a :: l1 => 190 | match n with 191 | O => o :: (restrict n l1) 192 | | S n1 => a :: (restrict n1 l1) 193 | end 194 | end. 195 | 196 | Theorem restrict_0: forall l, restrict 0 l = mk_0 (length l). 197 | intros l; elim l; simpl; auto with datatypes. 198 | intros; f_equal; auto. 199 | Qed. 200 | 201 | Theorem restrict_all: forall n l, length l <= n -> restrict n l = l. 202 | intros n l; generalize n; elim l; simpl; auto with datatypes; clear n l. 203 | intros a l Rec n; case n; auto with arith. 204 | intros H; contradict H; auto with arith. 205 | intros n1 H; f_equal; auto with arith. 206 | Qed. 207 | 208 | Theorem restrict_length: forall n l, length (restrict n l) = (length l). 209 | intros n l; generalize n; elim l; simpl; auto with datatypes; clear n l. 210 | intros a l Rec n; case n; simpl; auto. 211 | Qed. 212 | 213 | Theorem restrict_update: forall n l, S n <= length l -> 214 | restrict (S n) l = subst n (nth 0 (jump n l) o) (restrict n l). 215 | intros n l; generalize n; elim l; auto with datatypes; clear n l. 216 | intros n H; contradict H; auto with arith. 217 | intros a l1 Rec n; case n; auto; clear n. 218 | simpl length; intros n H; simpl; f_equal; auto with arith. 219 | Qed. 220 | 221 | Theorem restrict_nth: forall l n m, n < m -> 222 | nth n (restrict m l) o = nth n l o. 223 | intros l; elim l; simpl; auto; clear l. 224 | intros a l Rec n m; case m; auto; clear m. 225 | intros H; contradict H; auto with arith. 226 | intros m; case n; clear n; auto. 227 | intros n; simpl; auto with arith. 228 | Qed. 229 | 230 | 231 | Theorem restrict_nth_default: forall l n m, m <= n -> 232 | nth n (restrict m l) o = o. 233 | intros l; elim l; simpl; auto; clear l. 234 | intros n m; case n; auto with arith. 235 | intros a l Rec n m; case m; auto; clear m. 236 | rewrite restrict_0. 237 | case n; simpl; auto. 238 | intros n1 _; generalize n1; elim (length l); clear n1; simpl; auto. 239 | intros n1; case n1; auto. 240 | intros n2 Rec1 n1; case n1; simpl; auto. 241 | intros n2; case n; simpl; auto with arith. 242 | intros H; contradict H; auto with arith. 243 | Qed. 244 | 245 | End list_op. 246 | 247 | Arguments jump [A]. 248 | Arguments take [A]. 249 | Arguments take_and_jump [A]. 250 | Arguments subst [A]. 251 | Arguments restrict [A]. 252 | Arguments mk_0 [A]. 253 | 254 | (* Build the list [m; m+1; ...; m+n] *) 255 | Fixpoint progression (n m: nat) {struct n}: list nat := 256 | match n with O => nil | S n1 => m :: progression n1 (S m) end. 257 | 258 | (* A progression is a unique list *) 259 | Theorem progression_list: forall n m, ulist (progression n m). 260 | assert (E1: forall n m p , In p (progression n m) -> m <= p). 261 | intros n; elim n; simpl; auto with datatypes; clear n. 262 | intros m p H; case H. 263 | intros n Rec m p [H | H]; subst; auto with arith. 264 | apply Nat.le_trans with (S m); auto with arith. 265 | intros n; elim n; simpl; clear n; auto. 266 | intros n Rec m; apply ulist_cons; auto. 267 | intros H; generalize (E1 _ _ _ H); auto with arith. 268 | intros H1; contradict H1; auto with arith. 269 | Qed. 270 | 271 | (* Define the element of a progression *) 272 | Theorem in_progression: forall n a i, 273 | In i (progression n a) <-> a <= i < n + a. 274 | intros n; elim n; simpl; auto. 275 | intros a i; split; try (intros H; case H; fail); 276 | intros (H1, H2); contradict H1; auto with arith. 277 | intros n1 Rec a i; case (Rec (S a) i); clear Rec; intros H1 H2. 278 | split; intros H. 279 | case H; intros H3; subst; auto with arith. 280 | case H1; try rewrite plus_n_Sm; auto with arith. 281 | case H; intros H3 H4. 282 | case le_lt_eq_dec with (1 := H3); auto with arith. 283 | rewrite plus_n_Sm in H4; auto with arith. 284 | Qed. 285 | 286 | Fixpoint list_nat_eq (l1 l2: list nat) {struct l1}: bool := 287 | match l1, l2 with nil, nil => true 288 | | n1::l3, n2::l4 => 289 | if Nat.eqb n1 n2 then list_nat_eq l3 l4 else false 290 | | _, _ => false 291 | end. 292 | 293 | Lemma list_nat_eq_correct l1 l2 : 294 | if list_nat_eq l1 l2 then l1 = l2 else l1 <> l2. 295 | Proof. 296 | revert l2. 297 | induction l1 as [| n1 l1 Hrec]; destruct l2 as [| n2 l2]; simpl; 298 | try (intros; discriminate); auto. 299 | destruct (Nat.eqb_spec n1 n2) as [n1En2|H1]. 300 | generalize (Hrec l2); case list_nat_eq; intros H2. 301 | apply f_equal2 with (f := @cons _); auto. 302 | intros HH; case H2; injection HH; auto. 303 | intros HH; case H1; injection HH; auto. 304 | Qed. 305 | -------------------------------------------------------------------------------- /theories/OrderedList.v: -------------------------------------------------------------------------------- 1 | (* This program is free software; you can redistribute it and/or *) 2 | (* modify it under the terms of the GNU Lesser General Public License *) 3 | (* as published by the Free Software Foundation; either version 2.1 *) 4 | (* of the License, or (at your option) any later version. *) 5 | (* *) 6 | (* This program is distributed in the hope that it will be useful, *) 7 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 8 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 9 | (* GNU General Public License for more details. *) 10 | (* *) 11 | (* You should have received a copy of the GNU Lesser General Public *) 12 | (* License along with this program; if not, write to the Free *) 13 | (* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *) 14 | (* 02110-1301 USA *) 15 | 16 | 17 | (********************************************************) 18 | (* OrderedList.v *) 19 | (* Ordered List *) 20 | (* thery@sophia.inria.fr *) 21 | (* (2006) *) 22 | (********************************************************) 23 | Require Import List. 24 | Require Import Permutation. 25 | Require Import UList. 26 | 27 | Section ordered. 28 | 29 | (* The type of the elements in the list *) 30 | Variable A: Set. 31 | 32 | (* Comparison values *) 33 | Inductive cmp : Set := lt | eq | gt. 34 | 35 | (* Opposite *) 36 | Definition opp v := match v with lt => gt | eq => eq | gt => lt end. 37 | 38 | (* Weight function *) 39 | Variable weight: A -> A -> cmp. 40 | 41 | (* Transitivity *) 42 | Hypothesis weight_trans: 43 | forall a b c, weight a b = weight b c -> weight a c = weight a b. 44 | 45 | (* Anti symmetry *) 46 | Hypothesis weight_anti_sym: 47 | forall a b, weight b a = opp (weight a b). 48 | 49 | (* Reflexivity *) 50 | Theorem weight_refl: forall a, weight a a = eq. 51 | intros a; generalize (weight_anti_sym a a); 52 | case (weight a a); auto; intros; discriminate. 53 | Qed. 54 | 55 | (* Compatibility left *) 56 | Hypothesis weight_compat_l: 57 | forall a b c, weight a b = eq -> weight a c = weight b c. 58 | 59 | (* Compatibility right *) 60 | Theorem weight_compat_r: 61 | forall a b c, weight a b = eq -> weight c a = weight c b. 62 | intros a b c H; repeat rewrite (fun x => weight_anti_sym x c). 63 | rewrite weight_compat_l with (b := b); auto. 64 | Qed. 65 | 66 | (* No collision *) 67 | Hypothesis weight_exact: 68 | forall a b, weight a b = eq -> a = b. 69 | 70 | Theorem weight_equiv: 71 | forall a b, weight a b = eq <-> a = b. 72 | intros a b; split; intros H; subst; auto. 73 | apply weight_refl. 74 | Qed. 75 | 76 | Definition A_dec : forall a b: A, {a = b} + {a <> b}. 77 | intros a b; generalize (weight_equiv a b); 78 | case (weight a b); intros (H1, H2); auto. 79 | right; intros H; generalize (H2 H); intros; discriminate. 80 | right; intros H; generalize (H2 H); intros; discriminate. 81 | Defined. 82 | 83 | (* Ordered list *) 84 | Inductive olist: list A -> Prop := 85 | olist_nil: olist nil 86 | | olist_one: forall a, olist (a :: nil) 87 | | olist_cons: forall a b l, 88 | weight a b = lt -> olist (b::l) -> olist (a::b::l). 89 | 90 | (* Removing the first element of an ordered list, the list 91 | remains ordered 92 | *) 93 | Theorem olist_inv: forall a l, olist (a :: l) -> olist l. 94 | intros a l; case l; simpl; auto. 95 | intros H; apply olist_nil. 96 | intros a1 l1 H; inversion H; auto. 97 | Qed. 98 | 99 | (* Removing the second element of an ordered list, the list 100 | remains ordered 101 | *) 102 | Theorem olist_skip: 103 | forall a b l, olist (a :: b :: l) -> olist (a :: l). 104 | intros a b l; generalize a b; elim l; simpl; auto. 105 | intros; apply olist_one. 106 | intros a1 l1 Rec a2 b1 H. 107 | assert (Eq1: weight a2 b1 = lt). 108 | inversion H; auto. 109 | assert (Eq2: weight b1 a1 = lt). 110 | inversion_clear H as [| H0 H1|]; auto. 111 | inversion_clear H1 ; auto. 112 | apply olist_cons; auto. 113 | rewrite weight_trans with (b := b1); auto. 114 | apply trans_equal with (1 := Eq1); auto. 115 | inversion_clear H; auto. 116 | inversion_clear H1; auto. 117 | Qed. 118 | 119 | 120 | (* All the elements in an ordered list are smaller than the head *) 121 | Theorem olist_weight: 122 | forall a b l, olist (a :: l) -> In b l -> weight a b = lt. 123 | intros a b l H; generalize a b H; elim l; clear a b l H. 124 | intros a b _ H1; case H1. 125 | simpl; intros a1 l Rec a b H [H1 | H1]; subst; auto. 126 | inversion H; auto. 127 | assert (Eq1: weight a a1 = lt). 128 | inversion H; auto. 129 | rewrite weight_trans with (b := a1); auto. 130 | rewrite Eq1; apply sym_equal; apply Rec; auto. 131 | inversion_clear H; auto. 132 | Qed. 133 | 134 | (* An ordered list is unique *) 135 | Theorem olist_ulist: forall l, olist l -> ulist l. 136 | intros l; elim l; simpl; auto. 137 | intros a l1; case l1; auto. 138 | intros b l2 Rec H; inversion_clear H as [| H0 H1 |]. 139 | apply ulist_cons; auto. 140 | simpl; intros [H2 | H2]; subst; auto. 141 | rewrite weight_refl in H0; discriminate. 142 | generalize (weight_anti_sym a b); rewrite H0. 143 | rewrite olist_weight with (l := l2); auto. 144 | intros; discriminate. 145 | Qed. 146 | 147 | (* Check if a literal is in a clause *) 148 | Fixpoint is_in (a: A) (l: list A) {struct l}: bool := 149 | match l with 150 | nil => false 151 | | b :: l1 => 152 | match weight a b with 153 | eq => true 154 | | lt => false 155 | | gt => is_in a l1 156 | end 157 | end. 158 | 159 | Theorem is_in_correct: 160 | forall a l, olist l -> if is_in a l then In a l else ~ In a l. 161 | intros a l; elim l; simpl; auto. 162 | intros b l1 Rec H. 163 | assert (F0: olist l1); try (apply olist_inv with (1 := H)). 164 | case_eq (weight a b); intros H1; auto. 165 | intros [H3 | H3]; subst; auto. 166 | rewrite weight_refl in H1; discriminate. 167 | generalize (weight_anti_sym b a); rewrite H1. 168 | rewrite olist_weight with (l := l1); simpl; intros; auto; 169 | discriminate. 170 | rewrite weight_exact with (1 := H1); auto. 171 | generalize (Rec F0); case (is_in a l1); auto. 172 | intros H3 [H4 | H4]; subst; auto. 173 | rewrite weight_refl in H1; discriminate. 174 | Qed. 175 | 176 | (* Insert an element in an ordered list with duplication *) 177 | Fixpoint insert (a: A) (l: list A) {struct l}: list A := 178 | match l with 179 | nil => a :: nil 180 | | b :: l1 => 181 | match weight a b with 182 | lt => a :: l 183 | | eq => l 184 | | gt => b :: insert a l1 185 | end 186 | end. 187 | 188 | (* The inserted element is in the result *) 189 | Theorem insert_in: forall a l, In a (insert a l). 190 | intros a l; elim l; simpl; auto. 191 | intros b l1 H; case_eq (weight a b); auto with datatypes. 192 | intros H1; rewrite weight_exact with (1 := H1); 193 | auto with datatypes. 194 | Qed. 195 | 196 | (* The initial list is in the result *) 197 | Theorem insert_incl: forall a l, incl l (insert a l). 198 | intros a l; elim l; simpl; auto with datatypes. 199 | intros b l1 H; case_eq (weight a b); auto with datatypes. 200 | Qed. 201 | 202 | (* The result contains only the initial list or the inserted element *) 203 | Theorem insert_inv: forall a b l, In a (insert b l) -> a = b \/ In a l. 204 | intros a b l; elim l; simpl; auto with datatypes. 205 | intuition. 206 | intros c l1 H; case_eq (weight b c); simpl; auto with datatypes. 207 | intuition. 208 | intuition. 209 | Qed. 210 | 211 | (* If the initial list is ordered so is the result *) 212 | Theorem insert_olist: forall a l, olist l -> olist (insert a l). 213 | intros a l; elim l; simpl; auto. 214 | intros; apply olist_one; auto. 215 | intros b l1 Rec H; case_eq (weight a b); intros H1; auto. 216 | apply olist_cons; auto. 217 | assert (Eq1: olist l1); try apply olist_inv with (1 := H). 218 | generalize (Rec Eq1). 219 | assert (Eq2: forall c, In c (insert a l1) -> weight b c = lt). 220 | intros c H2. 221 | case insert_inv with (1 := H2); auto. 222 | intros; subst; rewrite weight_anti_sym, H1; auto. 223 | intros H3; apply olist_weight with (1 := H); auto. 224 | generalize Eq2; case (insert a l1); auto. 225 | intros; apply olist_one. 226 | intros c l2 H2 H3; apply olist_cons; auto with datatypes. 227 | Qed. 228 | 229 | (* Insert an element in an ordered list l if needed (a does not 230 | occur in l) and then call the continuation f with the tail of l 231 | *) 232 | Fixpoint insert_cont (f: list A -> list A) (a: A) (l: list A) {struct l}: 233 | list A := 234 | match l with 235 | nil => a :: f nil 236 | | b :: l1 => 237 | match weight a b with 238 | lt => a :: f l 239 | | eq => a :: f l1 240 | | gt => b :: insert_cont f a l1 241 | end 242 | end. 243 | 244 | (* Merge two ordered lists *) 245 | Fixpoint merge (l1 l2: list A) {struct l1}: list A := 246 | match l1 with 247 | nil => l2 248 | | a :: l3 => insert_cont (merge l3) a l2 249 | end. 250 | 251 | Theorem merge_incl_l: forall l1 l2, incl l1 (merge l1 l2). 252 | intros l1; elim l1; simpl; auto with datatypes; clear l1. 253 | intros l1 a H; case H. 254 | intros a l1 Rec l2 b; simpl; intros [H | H]; subst; auto. 255 | elim l2; simpl; auto; clear l2. 256 | intros c l2 Rec1; case_eq (weight b c); intros H; auto with datatypes. 257 | elim l2; simpl; auto; clear l2. 258 | right; apply (Rec nil b); auto. 259 | intros c l2 Rec1; case_eq (weight a c); intros H1; auto with datatypes. 260 | simpl; right; apply (Rec (c :: l2) b); auto. 261 | simpl; right; apply (Rec l2 b); auto. 262 | Qed. 263 | 264 | Theorem merge_incl_r: forall l1 l2, incl l2 (merge l1 l2). 265 | intros l1; elim l1; simpl; auto with datatypes. 266 | intros a l3 Rec l2; elim l2; simpl; auto with datatypes; clear l2. 267 | intros b l2 Rec1; case_eq (weight a b); intros H; auto with datatypes. 268 | intro c; simpl; intros [H1 | H1]; subst. 269 | left; apply weight_exact; auto. 270 | right; apply (Rec l2 c); auto. 271 | Qed. 272 | 273 | Theorem merge_inv: forall a l1 l2, In a (merge l1 l2) -> In a l1 \/ In a l2. 274 | intros a l1; elim l1; simpl; auto; clear l1. 275 | intros b l1 Rec l2; elim l2; simpl; auto; clear l2. 276 | intros [H | H]; auto. 277 | case (Rec nil); auto. 278 | intros c l2 Rec1; case (weight b c); simpl; intros [H | H]; subst; auto. 279 | case (Rec (c :: l2)); auto. 280 | case (Rec l2); auto. 281 | case Rec1; auto. 282 | Qed. 283 | 284 | (* Old trick to prove that ordering is preserved we first need 285 | to prove something stronger 286 | *) 287 | Theorem merge_olist_strong: forall a l1 l2, 288 | olist (a :: l1) -> olist (a :: l2) -> olist (a :: merge l1 l2). 289 | intros a l1; generalize a; elim l1; simpl; auto; clear a l1. 290 | intros b l1 Rec a l2 H. 291 | assert (V1: weight a b = lt); try apply olist_weight with (1 := H); auto with datatypes. 292 | assert (V2: olist (b :: l1)); try apply olist_inv with (1 := H). 293 | generalize a V1; elim l2; simpl; clear a l2 H V1; auto. 294 | intros a V1 _; apply olist_cons; auto. 295 | apply Rec; auto. 296 | apply olist_one; auto. 297 | intros c l2 Rec1 a V1 H1; case_eq (weight b c); intros H2. 298 | apply olist_cons; auto. 299 | apply Rec; auto with datatypes. 300 | apply olist_cons; auto. 301 | apply olist_inv with (1 := H1); auto. 302 | apply olist_cons; auto. 303 | apply Rec; auto with datatypes. 304 | rewrite weight_exact with (1 := H2); auto. 305 | apply olist_inv with (1 := H1); auto. 306 | apply olist_cons; auto. 307 | apply olist_weight with (1 := H1); auto with datatypes. 308 | apply Rec1; auto. 309 | rewrite weight_anti_sym, H2; auto. 310 | apply olist_inv with (1 := H1); auto. 311 | Qed. 312 | 313 | (* merge keeps ordering *) 314 | Theorem merge_olist: forall l1 l2, 315 | olist l1 -> olist l2 -> olist (merge l1 l2). 316 | intros l1; case l1; clear l1; simpl; auto. 317 | intros a l1 l2; case l2; simpl; auto; clear l2. 318 | intros; apply merge_olist_strong; auto. 319 | apply olist_one; auto. 320 | intros b l2 H H1. 321 | case_eq (weight a b); intros H2; auto. 322 | apply merge_olist_strong; auto. 323 | apply olist_cons; auto. 324 | apply merge_olist_strong; auto. 325 | rewrite weight_exact with (1 := H2); auto. 326 | generalize b H H1 H2; elim l2; simpl; auto; clear l2 b H H1 H2. 327 | intros b H H1 H2; apply olist_cons; auto. 328 | rewrite weight_anti_sym, H2; auto. 329 | apply merge_olist_strong; auto. 330 | apply olist_one; auto. 331 | intros b l2 Rec c H H1 H2. 332 | case_eq (weight a b); intros H3; auto. 333 | apply olist_cons; auto. 334 | rewrite weight_anti_sym; rewrite H2; auto. 335 | apply merge_olist_strong; auto. 336 | apply olist_cons; auto. 337 | apply olist_inv with (1 := H1); auto. 338 | apply olist_cons; auto. 339 | rewrite weight_anti_sym; rewrite H2; auto. 340 | apply merge_olist_strong; auto. 341 | rewrite weight_exact with (1 := H3); auto. 342 | apply olist_inv with (1 := H1); auto. 343 | apply olist_cons; auto. 344 | apply olist_weight with (1 := H1); auto with datatypes. 345 | apply Rec; auto. 346 | apply olist_inv with (1 := H1); auto. 347 | Qed. 348 | 349 | 350 | (* Insert an element in an ordered list *) 351 | Fixpoint ocons (a: A) (l: list A) {struct l}: list A := 352 | match l with 353 | nil => a :: nil 354 | | b :: l1 => 355 | match weight a b with 356 | lt => a :: l 357 | | eq => a :: l 358 | | gt => b :: ocons a l1 359 | end 360 | end. 361 | 362 | (* ocons always increments the length *) 363 | Theorem ocons_length: forall a l, length (ocons a l) = S (length l). 364 | intros a l; elim l; simpl; auto. 365 | intros b l1 H; case (weight a b); simpl; auto. 366 | Qed. 367 | 368 | (* The inserted element is in the result *) 369 | Theorem ocons_in: forall a l, In a (ocons a l). 370 | intros a l; elim l; simpl; auto. 371 | intros b l1 H; case_eq (weight a b); auto with datatypes. 372 | Qed. 373 | 374 | (* The initial list is in the result *) 375 | Theorem ocons_incl: forall a l, incl l (ocons a l). 376 | intros a l; elim l; simpl; auto with datatypes. 377 | intros b l1 H; case_eq (weight a b); auto with datatypes. 378 | Qed. 379 | 380 | (* The result contains only the initial list or the inserted element *) 381 | Theorem ocons_inv: forall a b l, In a (ocons b l) -> a = b \/ In a l. 382 | intros a b l; elim l; simpl; auto with datatypes. 383 | intuition. 384 | intros c l1 H; case_eq (weight b c); simpl; auto with datatypes. 385 | intuition. 386 | intuition. 387 | intuition. 388 | Qed. 389 | 390 | (* Add an element in an ordered list l with possible duplication 391 | and then call the continuation f with the tail of l 392 | *) 393 | Fixpoint add_cont (f: list A -> list A) (a: A) (l: list A) {struct l}: 394 | list A := 395 | match l with 396 | nil => a :: f nil 397 | | b :: l1 => 398 | match weight a b with 399 | lt => a :: f l 400 | | eq => a :: f l 401 | | gt => b :: add_cont f a l1 402 | end 403 | end. 404 | 405 | (* Add two ordered lists with possible duplication *) 406 | Fixpoint add (l1 l2: list A) {struct l1}: list A := 407 | match l1 with 408 | nil => l2 409 | | a :: l3 => add_cont (add l3) a l2 410 | end. 411 | 412 | Theorem add_length: forall l1 l2, length (add l1 l2) = length l1 + length l2. 413 | intros l1; elim l1; simpl; auto; clear l1. 414 | intros a l1 Rec l2; elim l2. 415 | - simpl; auto; clear l2; rewrite Rec; auto. 416 | - simpl; clear l2; intros b l2 Rec1; case (weight a b); simpl. 417 | * rewrite Rec; simpl; repeat rewrite <- plus_n_Sm; auto with arith. 418 | * rewrite Rec; simpl; repeat rewrite <- plus_n_Sm; auto with arith. 419 | * rewrite Rec1; simpl; repeat rewrite <- plus_n_Sm; auto with arith. 420 | Qed. 421 | 422 | Theorem add_incl_l: forall l1 l2, incl l1 (add l1 l2). 423 | intros l1; elim l1; simpl; auto with datatypes; clear l1. 424 | intros l1 a H; case H. 425 | intros a l1 Rec l2 b; simpl; intros [H | H]; subst; auto. 426 | elim l2; simpl; auto; clear l2. 427 | intros c l2 Rec1; case_eq (weight b c); intros H; auto with datatypes. 428 | elim l2; simpl; auto; clear l2. 429 | right; apply (Rec nil b); auto. 430 | intros c l2 Rec1; case_eq (weight a c); intros H1; auto with datatypes. 431 | simpl; right; apply (Rec (c :: l2) b); auto. 432 | simpl; right; apply (Rec (c :: l2) b); auto. 433 | Qed. 434 | 435 | Theorem add_incl_r: forall l1 l2, incl l2 (add l1 l2). 436 | intros l1; elim l1; simpl; auto with datatypes. 437 | intros a l3 Rec l2; elim l2; simpl; auto with datatypes; clear l2. 438 | intros b l2 Rec1; case_eq (weight a b); intros H; auto with datatypes. 439 | Qed. 440 | 441 | Theorem add_inv: forall a l1 l2, In a (add l1 l2) -> In a l1 \/ In a l2. 442 | intros a l1; elim l1; simpl; auto; clear l1. 443 | intros b l1 Rec l2; elim l2; simpl; auto; clear l2. 444 | intros [H | H]; auto. 445 | case (Rec nil); auto. 446 | intros c l2 Rec1; case (weight b c); simpl; intros [H | H]; subst; auto. 447 | case (Rec (c :: l2)); auto. 448 | case (Rec (c :: l2)); auto. 449 | case Rec1; auto. 450 | Qed. 451 | 452 | (* Remove an element from the list l if needed and then call 453 | the continuation f on the tail of l 454 | *) 455 | Fixpoint rm_cont (f: list A -> list A) (a: A) (l: list A) {struct l}: 456 | list A := 457 | match l with 458 | nil => nil 459 | | b :: l1 => 460 | match weight a b with 461 | eq => f l1 462 | | lt => f l 463 | | gt => b :: rm_cont f a l1 464 | end 465 | end. 466 | 467 | (* Remove all the element of the list l1 from the list l2 *) 468 | Fixpoint rm (l1 l2: list A) {struct l1}: list A := 469 | match l1 with 470 | nil => l2 471 | | a :: l3 => 472 | rm_cont (rm l3) a l2 473 | end. 474 | 475 | Theorem rm_incl: forall l1 l2, incl (rm l1 l2) l2. 476 | intros l1; elim l1; simpl; auto with datatypes; clear l1. 477 | intros a l1 Rec l2; elim l2; simpl; auto with datatypes; clear l2. 478 | intros b l2 H; case_eq (weight a b); auto with datatypes. 479 | Qed. 480 | 481 | Theorem rm_not_in: forall (a: A) l1 l2, olist l1 -> olist l2 -> 482 | In a l1 -> ~ In a (rm l1 l2). 483 | intros a l1; generalize a; elim l1; simpl; auto; clear a l1. 484 | intros b l1 Rec a l2 H1 H2. 485 | assert (O1: olist l1); try apply olist_inv with (1 := H1). 486 | intros [H | H]; subst; auto. 487 | generalize H2; elim l2; simpl; auto with datatypes; clear l2 H2. 488 | intros b l2 Rec1 H2. 489 | assert (O2: olist l2); try apply olist_inv with (1 := H2). 490 | case_eq (weight a b); auto with datatypes; intros H3. 491 | intros H4; absurd (In a (b :: l2)); auto. 492 | simpl; intros [H5 | H5]; subst. 493 | rewrite weight_refl in H3; discriminate. 494 | rewrite weight_anti_sym in H3; rewrite (olist_weight b a l2) in H3; 495 | try discriminate; auto. 496 | apply (rm_incl l1 (b :: l2) a); auto. 497 | assert (a = b); subst. 498 | apply weight_exact with (1 := H3). 499 | intros H4; absurd (In b l2); auto. 500 | assert (H5: ulist (b :: l2)); try apply olist_ulist; auto. 501 | inversion H5; auto. 502 | apply (rm_incl l1 l2 b); auto. 503 | simpl; intros [H4 | H4]; subst. 504 | rewrite weight_refl in H3; discriminate. 505 | case Rec1; auto. 506 | generalize H2; elim l2; simpl; auto with datatypes; clear l2 H2. 507 | intros c l2 Rec1 H2. 508 | assert (O2: olist l2); try apply olist_inv with (1 := H2). 509 | case_eq (weight b c); auto with datatypes; intros H3. 510 | simpl; intros [H4 | H4]; subst. 511 | rewrite (olist_weight b a l1) in H3; auto; discriminate. 512 | case Rec1; auto. 513 | Qed. 514 | 515 | Theorem rm_in: forall (a: A) l1 l2, olist l1 -> olist l2 -> 516 | ~ In a l1 -> In a l2 -> In a (rm l1 l2). 517 | intros a l1; generalize a; elim l1; simpl; auto; clear a l1. 518 | intros b l1 Rec a l2 H1 H2 H3 H4. 519 | generalize H2 H4; elim l2; simpl; auto; clear l2 H2 H4. 520 | assert (O1: olist l1); try apply olist_inv with (1 := H1). 521 | intros c l3 Rec1 H4 [H5 | H5]; subst. 522 | case_eq (weight b a); auto with datatypes; intros H5. 523 | case H3; rewrite weight_exact with (1 := H5); auto. 524 | assert (O2: olist l3); try apply olist_inv with (1 := H4). 525 | case_eq (weight b c); auto with datatypes; intros H6. 526 | Qed. 527 | 528 | Theorem rm_olist_strong: forall a l1 l2, 529 | olist (a :: l2) -> olist (a :: rm l1 l2). 530 | intros a l1; generalize a; elim l1; simpl; auto; clear a l1. 531 | intros a l1 Rec c l2; generalize c; elim l2; simpl; auto; clear c l2. 532 | intros b l2 Rec1 c H. 533 | case_eq (weight a b); intros H1; auto. 534 | apply Rec; auto. 535 | apply olist_skip with (1 := H); auto. 536 | apply olist_cons; auto. 537 | apply olist_weight with (1 := H); auto with datatypes. 538 | apply Rec1; auto. 539 | apply olist_inv with (1 := H); auto. 540 | Qed. 541 | 542 | Theorem rm_olist: forall l1 l2, olist l2 -> olist (rm l1 l2). 543 | intros l1; elim l1; simpl; auto; clear l1. 544 | intros a l1 Rec l2; case l2; simpl; auto; clear l2. 545 | intros b l2 H; case_eq (weight a b); intros H1; auto. 546 | apply Rec; auto. 547 | apply olist_inv with (1 := H); auto. 548 | generalize b H H1; elim l2; simpl; auto; clear b l2 H H1. 549 | intros b l2 Rec1 c H H1. 550 | case_eq (weight a b); intros H2; auto. 551 | apply rm_olist_strong; auto. 552 | apply rm_olist_strong; auto. 553 | apply olist_skip with (1 := H); auto. 554 | apply olist_cons; auto. 555 | apply olist_weight with (1 := H); auto with datatypes. 556 | apply Rec1; auto. 557 | apply olist_inv with (1 := H); auto. 558 | Qed. 559 | 560 | (** Lifting the order to a lexico on list *) 561 | 562 | (* Lexico on list *) 563 | Fixpoint lexico (l1 l2: list A) {struct l1}: cmp := 564 | match l1 with 565 | nil => match l2 with nil => eq | _ => lt end 566 | | a:: l3 => 567 | match l2 with 568 | nil => gt 569 | | b :: l4 => 570 | match weight a b with 571 | eq => lexico l3 l4 572 | | X => X 573 | end 574 | end 575 | end. 576 | 577 | Theorem lexico_trans: 578 | forall a b c, lexico a b = lexico b c -> lexico a c = lexico a b. 579 | intros a; elim a; simpl; auto; clear a. 580 | intros b; case b; auto; clear b. 581 | intros x b c; case c; clear c; simpl; auto. 582 | intros; discriminate. 583 | intros x a Rec; intros b c; case c; case b; clear b c; simpl; 584 | try (intros; discriminate; fail); auto. 585 | intros y b z c. 586 | case_eq (weight x y); auto; intros H1. 587 | case_eq (weight y z); auto; intros H2. 588 | rewrite (weight_trans x y z); rewrite H1; auto. 589 | rewrite <- (weight_compat_r y z x); auto. 590 | rewrite H1; auto. 591 | intros; discriminate. 592 | rewrite (weight_compat_l x y z); auto. 593 | case_eq (weight y z); auto; intros H2. 594 | case_eq (weight y z); auto; intros H2. 595 | intros; discriminate. 596 | rewrite <- (weight_compat_r y z x); auto. 597 | rewrite H1; auto. 598 | rewrite (weight_trans x y z); auto. 599 | rewrite H1; auto. 600 | rewrite H1; auto. 601 | Qed. 602 | 603 | Theorem lexico_anti_sym: 604 | forall a b, lexico b a = opp (lexico a b). 605 | intros a; elim a; clear a; simpl; auto. 606 | intros b; case b; clear b; simpl; auto. 607 | intros x a Rec b; case b; clear b; simpl; auto. 608 | intros y b; rewrite (weight_anti_sym x y). 609 | case (weight x y); simpl; auto. 610 | Qed. 611 | 612 | (* No collision *) 613 | Theorem lexico_exact: 614 | forall a b, lexico a b = eq -> a = b. 615 | intros a; elim a; simpl; auto; clear a. 616 | intros b; case b; auto. 617 | intros; discriminate. 618 | intros x a Rec b; case b; auto; clear b. 619 | intros; discriminate. 620 | intros y b. 621 | generalize (weight_exact x y). 622 | case (weight x y); auto. 623 | intros; discriminate. 624 | intros; f_equal; auto. 625 | intros; discriminate. 626 | Qed. 627 | 628 | End ordered. 629 | 630 | 631 | (* Computable equality test *) 632 | Definition eq_nat: forall x y: nat, {x = y} + {x <> y}. 633 | exact Nat.eq_dec. 634 | Defined. 635 | 636 | (* Comparison for integers *) 637 | Fixpoint test (n m: nat) {struct n}: cmp := 638 | match n with 639 | O => match m with O => eq | _ => lt end 640 | | S n1 => match m with O => gt | S m1 => test n1 m1 end 641 | end. 642 | 643 | Theorem test_trans: forall n1 n2 n3, 644 | test n1 n2 = test n2 n3 -> test n1 n3 = test n1 n2. 645 | intros n1; elim n1; simpl; auto; clear n1. 646 | intros n2; elim n2; simpl; auto; clear n2. 647 | intros n2 Rec n3; elim n3; simpl; auto; clear n3. 648 | intros; discriminate. 649 | intros n1 Rec n2; elim n2; clear n2; simpl; auto. 650 | intros n3; elim n3; simpl; auto; clear n3. 651 | intros; discriminate. 652 | intros n2 Rec1 n3; elim n3; simpl; auto; clear n3. 653 | Qed. 654 | 655 | Theorem test_anti_sym: forall n1 n2, test n1 n2 = opp (test n2 n1). 656 | intros n1; elim n1; simpl; auto; clear n1. 657 | intros n2; elim n2; simpl; auto; clear n2. 658 | intros n1 Rec n2; elim n2; simpl; auto; clear n2. 659 | Qed. 660 | 661 | Theorem test_exact: forall n1 n2, test n1 n2 = eq -> n1 = n2. 662 | intros n1; elim n1; simpl; auto; clear n1. 663 | intros n2; elim n2; simpl; auto; clear n2. 664 | intros; discriminate. 665 | intros n1 Rec n2; elim n2; simpl; auto; clear n2. 666 | intros; discriminate. 667 | Qed. 668 | 669 | Theorem test_compat_l: 670 | forall a b c, test a b = eq -> test a c = test b c. 671 | intros a; elim a; simpl; auto; clear a. 672 | intros b; case b; try (intros; discriminate; fail). 673 | intros c; case c; auto. 674 | intros a Rec b; case b; clear b. 675 | intros; discriminate. 676 | intros b c Hb; case c; simpl; auto. 677 | Qed. 678 | -------------------------------------------------------------------------------- /theories/Parse.v: -------------------------------------------------------------------------------- 1 | (* This program is free software; you can redistribute it and/or *) 2 | (* modify it under the terms of the GNU Lesser General Public License *) 3 | (* as published by the Free Software Foundation; either version 2.1 *) 4 | (* of the License, or (at your option) any later version. *) 5 | (* *) 6 | (* This program is distributed in the hope that it will be useful, *) 7 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 8 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 9 | (* GNU General Public License for more details. *) 10 | (* *) 11 | (* You should have received a copy of the GNU Lesser General Public *) 12 | (* License along with this program; if not, write to the Free *) 13 | (* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *) 14 | (* 02110-1301 USA *) 15 | 16 | Require Import String. 17 | Import Ascii. 18 | Require Import List. 19 | Open Scope string_scope. 20 | Definition sp := 32. 21 | Definition nl := 10. 22 | Definition sep := 124. 23 | 24 | Fixpoint beq_nat (a b: nat) {struct a}: bool := 25 | match a, b with 26 | S a1, S b1 => beq_nat a1 b1 27 | | 0, 0 => true 28 | | _,_ => false 29 | end. 30 | 31 | Definition is_num x := beq_nat ((48 - x) + (x - 57)) 0. 32 | Definition get_num x := x - 48. 33 | 34 | Fixpoint mkline s acc {struct s} := 35 | match s with 36 | String a s1 => 37 | let n := nat_of_ascii a in 38 | if beq_nat n sp then 39 | match acc with 40 | Some x => mkline s1 (Some (0::x)) 41 | | _ => mkline s1 None 42 | end 43 | else if beq_nat n nl then mkline s1 None 44 | else if beq_nat n sep then 45 | match acc with 46 | Some x => app (rev x) (mkline s1 (Some nil)) 47 | | None => mkline s1 (Some nil) 48 | end 49 | else if is_num n then 50 | match acc with 51 | Some x => mkline s1 (Some ((get_num n)::x)) 52 | | None => mkline s1 None 53 | end else mkline s1 None 54 | | _ => nil 55 | end. 56 | 57 | Definition parse p := mkline p None. 58 | -------------------------------------------------------------------------------- /theories/Permutation.v: -------------------------------------------------------------------------------- 1 | (* This program is free software; you can redistribute it and/or *) 2 | (* modify it under the terms of the GNU Lesser General Public License *) 3 | (* as published by the Free Software Foundation; either version 2.1 *) 4 | (* of the License, or (at your option) any later version. *) 5 | (* *) 6 | (* This program is distributed in the hope that it will be useful, *) 7 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 8 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 9 | (* GNU General Public License for more details. *) 10 | (* *) 11 | (* You should have received a copy of the GNU Lesser General Public *) 12 | (* License along with this program; if not, write to the Free *) 13 | (* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *) 14 | (* 02110-1301 USA *) 15 | 16 | 17 | (********************************************************************** 18 | Permutation.v 19 | 20 | Definition and properties of permutations 21 | 22 | Definition: permutation 23 | 24 | Laurent.Thery@inria.fr (2006) 25 | **********************************************************************) 26 | Require Export List. 27 | Require Export ListAux. 28 | From Coq Require Export Permutation. 29 | 30 | Section permutation. 31 | Variable A : Set. 32 | 33 | Hint Constructors Permutation : core. 34 | 35 | (************************************** 36 | A transposition is a permutation 37 | **************************************) 38 | 39 | Theorem perm_transposition : 40 | forall a b (l1 l2 l3 : list A), 41 | Permutation (l1 ++ a :: l2 ++ b :: l3) (l1 ++ b :: l2 ++ a :: l3). 42 | Proof. 43 | intros a b l1 l2 l3. 44 | apply Permutation_app; auto. 45 | change 46 | (Permutation ((a :: nil) ++ l2 ++ (b :: nil) ++ l3) 47 | ((b :: nil) ++ l2 ++ (a :: nil) ++ l3)) in |- *. 48 | repeat rewrite <- app_ass. 49 | apply Permutation_app; auto. 50 | apply perm_trans with ((b :: nil) ++ (a :: nil) ++ l2); auto. 51 | apply Permutation_app_comm; auto. 52 | repeat rewrite app_ass. 53 | apply Permutation_app; auto. 54 | apply Permutation_app_comm; auto. 55 | Qed. 56 | 57 | (************************************** 58 | An element of a list can be put on top of the list to get a permutation 59 | **************************************) 60 | 61 | Theorem in_permutation_ex : 62 | forall a l, In a l -> exists l1 : list A, Permutation (a :: l1) l. 63 | Proof. 64 | intros a l; elim l; simpl in |- *; auto. 65 | intros H; case H; auto. 66 | intros a0 l0 H [H0| H0]. 67 | exists l0; rewrite H0; auto. 68 | case H; auto; intros l1 Hl1; exists (a0 :: l1). 69 | apply perm_trans with (a0 :: a :: l1); auto. 70 | Qed. 71 | 72 | (************************************** 73 | Take a list and return tle list of all pairs of an element of the 74 | list and the remaining list 75 | **************************************) 76 | 77 | Fixpoint split_one (l : list A) : list (A * list A) := 78 | match l with 79 | | nil => nil (A:=A * list A) 80 | | a :: l1 => 81 | (a, l1) 82 | :: map (fun p : A * list A => (fst p, a :: snd p)) (split_one l1) 83 | end. 84 | 85 | (************************************** 86 | The pairs of the list are a permutation 87 | **************************************) 88 | 89 | Theorem split_one_permutation : 90 | forall (a : A) (l1 l2 : list A), 91 | In (a, l1) (split_one l2) -> Permutation (a :: l1) l2. 92 | Proof. 93 | intros a l1 l2; generalize a l1; elim l2; clear a l1 l2; simpl in |- *; auto. 94 | intros a l1 H1; case H1. 95 | intros a l H a0 l1 [H0| H0]. 96 | injection H0; intros H1 H2; rewrite H2, H1; auto. 97 | generalize H H0; elim (split_one l); simpl in |- *; auto. 98 | intros H1 H2; case H2. 99 | intros a1 l0 H1 H2 [H3| H3]; auto. 100 | injection H3; intros H4 H5; (rewrite <- H4, <- H5). 101 | apply perm_trans with (a :: fst a1 :: snd a1); auto. 102 | apply perm_skip. 103 | apply H2; auto. 104 | case a1; simpl in |- *; auto. 105 | Qed. 106 | 107 | (************************************** 108 | All elements of the list are there 109 | **************************************) 110 | 111 | Theorem split_one_in_ex : 112 | forall (a : A) (l1 : list A), 113 | In a l1 -> exists l2 : list A, In (a, l2) (split_one l1). 114 | Proof. 115 | intros a l1; elim l1; simpl in |- *; auto. 116 | intros H; case H. 117 | intros a0 l H [H0| H0]; auto. 118 | exists l; left; f_equal; auto. 119 | case H; auto. 120 | intros x H1; exists (a0 :: x); right; auto. 121 | apply 122 | (in_map (fun p : A * list A => (fst p, a0 :: snd p)) (split_one l) (a, x)); 123 | auto. 124 | Qed. 125 | 126 | (************************************** 127 | An auxiliary function to generate all permutations 128 | **************************************) 129 | 130 | Fixpoint all_permutations_aux (l : list A) (n : nat) {struct n} : 131 | list (list A) := 132 | match n with 133 | | O => nil :: nil 134 | | S n1 => 135 | flat_map 136 | (fun p : A * list A => 137 | map (cons (fst p)) (all_permutations_aux (snd p) n1)) ( 138 | split_one l) 139 | end. 140 | (************************************** 141 | Generate all the permutations 142 | **************************************) 143 | 144 | Definition all_permutations (l : list A) := all_permutations_aux l (length l). 145 | 146 | (************************************** 147 | All the elements of the list are permutations 148 | **************************************) 149 | 150 | Lemma all_permutations_aux_permutation : 151 | forall (n : nat) (l1 l2 : list A), 152 | n = length l2 -> In l1 (all_permutations_aux l2 n) -> Permutation l1 l2. 153 | Proof. 154 | intros n; elim n; simpl in |- *; auto. 155 | intros l1 l2; case l2. 156 | simpl in |- *; intros H0 [H1| H1]. 157 | rewrite <- H1; auto. 158 | case H1. 159 | simpl in |- *; intros; discriminate. 160 | intros n0 H l1 l2 H0 H1. 161 | case in_flat_map_ex with (1 := H1). 162 | clear H1; intros x; case x; clear x; intros a1 l3 (H1, H2). 163 | case in_map_inv with (1 := H2). 164 | simpl in |- *; intros y (H3, H4). 165 | rewrite H4; auto. 166 | apply perm_trans with (a1 :: l3); auto. 167 | apply perm_skip; auto. 168 | apply H with (2 := H3). 169 | apply eq_add_S. 170 | apply trans_equal with (1 := H0). 171 | change (length l2 = length (a1 :: l3)) in |- *. 172 | apply Permutation_length; auto. 173 | apply Permutation_sym; apply split_one_permutation; auto. 174 | apply split_one_permutation; auto. 175 | Qed. 176 | 177 | Theorem all_permutations_permutation : 178 | forall l1 l2 : list A, In l1 (all_permutations l2) -> Permutation l1 l2. 179 | Proof. 180 | intros l1 l2 H; apply all_permutations_aux_permutation with (n := length l2); 181 | auto. 182 | Qed. 183 | 184 | (************************************** 185 | A permutation is in the list 186 | **************************************) 187 | 188 | Lemma permutation_all_permutations_aux : 189 | forall (n : nat) (l1 l2 : list A), 190 | n = length l2 -> Permutation l1 l2 -> In l1 (all_permutations_aux l2 n). 191 | Proof. 192 | intros n; elim n; simpl in |- *; auto. 193 | intros l1 l2; case l2. 194 | intros H H0; rewrite (Permutation_nil (Permutation_sym H0)); auto with datatypes. 195 | simpl in |- *; intros; discriminate. 196 | intros n0 H l1; case l1. 197 | intros l2 H0 H1; 198 | rewrite (Permutation_nil H1) in H0; 199 | discriminate. 200 | clear l1; intros a1 l1 l2 H1 H2. 201 | case (split_one_in_ex a1 l2); auto. 202 | apply Permutation_in with (1 := H2); auto with datatypes. 203 | intros x H0. 204 | apply in_flat_map with (b := (a1, x)); auto. 205 | apply in_map; simpl in |- *. 206 | apply H; auto. 207 | apply eq_add_S. 208 | apply trans_equal with (1 := H1). 209 | change (length l2 = length (a1 :: x)) in |- *. 210 | apply Permutation_length; auto. 211 | apply Permutation_sym; apply split_one_permutation; auto. 212 | apply Permutation_cons_inv with (a := a1). 213 | apply perm_trans with (1 := H2). 214 | apply Permutation_sym; apply split_one_permutation; auto. 215 | Qed. 216 | 217 | Theorem permutation_all_permutations : 218 | forall l1 l2 : list A, Permutation l1 l2 -> In l1 (all_permutations l2). 219 | Proof. 220 | intros l1 l2 H; unfold all_permutations in |- *; 221 | apply permutation_all_permutations_aux; auto. 222 | Qed. 223 | 224 | (************************************** 225 | Permutation is decidable 226 | **************************************) 227 | 228 | Definition permutation_dec : 229 | (forall a b : A, {a = b} + {a <> b}) -> 230 | forall l1 l2 : list A, {Permutation l1 l2} + {~ Permutation l1 l2}. 231 | intros H l1 l2. 232 | case (In_dec (list_eq_dec H) l1 (all_permutations l2)). 233 | intros i; left; apply all_permutations_permutation; auto. 234 | intros i; right; contradict i; apply permutation_all_permutations; auto. 235 | Defined. 236 | 237 | (* A more efficient version *) 238 | Definition permutation_dec1 : 239 | (forall a b : A, {a = b} + {a <> b}) -> 240 | forall l1 l2 : list A, {Permutation l1 l2} + {~ Permutation l1 l2}. 241 | intros dec; fix perm 1; intros l1; case l1. 242 | intros l2; case l2. 243 | left; auto. 244 | intros a l3; right; intros H; generalize (Permutation_length H); 245 | discriminate. 246 | intros a l3 l2. 247 | case (In_dec1 dec a l2); intros H1. 248 | case H1. 249 | intros x; case x; simpl. 250 | intros l4 l5 Hl4l5. 251 | case (perm l3 (l4 ++ l5)); intros H2. 252 | left; subst. 253 | apply perm_trans with ((a::l5) ++ l4); auto. 254 | simpl; apply perm_skip; auto. 255 | apply perm_trans with (1 := H2); auto. 256 | apply Permutation_app_comm. 257 | apply Permutation_app_comm. 258 | right; contradict H2. 259 | apply Permutation_cons_inv with a. 260 | apply perm_trans with (1 := H2). 261 | rewrite Hl4l5. 262 | apply perm_trans with ((a::l5) ++ l4); auto. 263 | apply Permutation_app_comm. 264 | simpl; apply perm_skip; auto. 265 | apply Permutation_app_comm. 266 | right; contradict H1. 267 | apply Permutation_in with (1 := H1); auto with datatypes. 268 | Defined. 269 | 270 | End permutation. 271 | 272 | (************************************** 273 | Hints 274 | **************************************) 275 | 276 | Global Hint Resolve Permutation_app : core. 277 | Global Hint Resolve Permutation_app_comm : core. 278 | 279 | (************************************** 280 | Implicits 281 | **************************************) 282 | 283 | Arguments permutation_dec1 [A]. 284 | 285 | (************************************** 286 | Permutation of a map can be inverted 287 | *************************************) 288 | 289 | Lemma Permutation_map_ex_aux : 290 | forall (A B : Set) (f : A -> B) l1 l2 l3, 291 | Permutation l1 l2 -> 292 | l1 = map f l3 -> exists l4, Permutation l4 l3 /\ l2 = map f l4. 293 | Proof. 294 | intros A B f l1 l2 l3 H H0. 295 | assert (exists l4 : list A, l2 = map f l4 /\ Permutation l4 l3). 296 | { 297 | rewrite H0 in H. 298 | apply Permutation_sym in H. 299 | epose proof (Permutation_map_inv f _ H). 300 | destruct H1; auto. 301 | now exists x. 302 | } 303 | destruct H1. 304 | now exists x. 305 | Qed. 306 | 307 | Theorem Permutation_map_ex : 308 | forall (A B : Set) (f : A -> B) l1 l2, 309 | Permutation (map f l1) l2 -> 310 | exists l3, Permutation l3 l1 /\ l2 = map f l3. 311 | Proof. 312 | intros A0 B f l1 l2 H; apply Permutation_map_ex_aux with (l1 := map f l1); 313 | auto. 314 | Qed. 315 | 316 | (************************************** 317 | Permutation is compatible with flat_map 318 | **************************************) 319 | 320 | Theorem permutation_flat_map : 321 | forall (A B : Set) (f : A -> list B) l1 l2, 322 | Permutation l1 l2 -> Permutation (flat_map f l1) (flat_map f l2). 323 | Proof. 324 | intros A B f l1 l2 H; elim H; simpl in |- *; auto. 325 | intros a b l; auto. 326 | repeat rewrite <- app_ass. 327 | apply Permutation_app; auto. 328 | intros k3 l4 l5 H0 H1 H2 H3; apply perm_trans with (1 := H1); auto. 329 | Qed. 330 | -------------------------------------------------------------------------------- /theories/Print.v: -------------------------------------------------------------------------------- 1 | (* This program is free software; you can redistribute it and/or *) 2 | (* modify it under the terms of the GNU Lesser General Public License *) 3 | (* as published by the Free Software Foundation; either version 2.1 *) 4 | (* of the License, or (at your option) any later version. *) 5 | (* *) 6 | (* This program is distributed in the hope that it will be useful, *) 7 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 8 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 9 | (* GNU General Public License for more details. *) 10 | (* *) 11 | (* You should have received a copy of the GNU Lesser General Public *) 12 | (* License along with this program; if not, write to the Free *) 13 | (* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *) 14 | (* 02110-1301 USA *) 15 | 16 | Require Import List. 17 | Require Import String. 18 | 19 | (* Printing function *) 20 | 21 | Fixpoint is_eq (n m: nat) {struct n} := 22 | match n, m with 23 | 0, 0 => true | (S n1), (S m1) => is_eq n1 m1 | _ ,_ => false end. 24 | 25 | Fixpoint adiv (n m p: nat) {struct p} := 26 | match p with 0 => false | (S p1) => 27 | if (is_eq n m) then true else adiv (n - m) m p1 28 | end. 29 | 30 | Definition div n m := 31 | match m with 0 => true | _ => adiv m n m end. 32 | 33 | Fixpoint print_line (n m: nat) (l: list nat) {struct n}: 34 | string * list nat := 35 | let v := if (div m n) then "|"%string else ""%string in 36 | match n, l with 37 | O , _ => (v, l) 38 | | (S n1), (0 :: l1) => 39 | let (s1, l2) := print_line n1 m l1 in 40 | (append v (append " " s1), 41 | l2) 42 | | (S n1), (n :: l1) => 43 | let (s1, l2) := print_line n1 m l1 in 44 | (append v 45 | (String (Ascii.ascii_of_nat (n + 48)) s1), 46 | l2) 47 | | _,_ => ("error"%string , l) 48 | end. 49 | 50 | Fixpoint paux (m n p q: nat) (s: string) (l: list nat) {struct m}: 51 | string := 52 | let v := if (div p m) then s else ""%string in 53 | append v 54 | match m with 55 | O => ""%string 56 | | (S m1) => 57 | let (s1, l1) := print_line n q l in 58 | append s1 (String (Ascii.ascii_of_nat 10) (paux m1 n p q s l1)) 59 | end. 60 | 61 | Fixpoint print_sep (n: nat): string := 62 | match n with 0 => ""%string | S n1 => append "-" (print_sep n1) end. 63 | 64 | Definition print n m s := 65 | let lf := Ascii.ascii_of_nat 10 in 66 | let nm := n * m in 67 | let s1 := (append 68 | (print_sep (1 + n + nm)) 69 | (String lf ""%string)) 70 | in 71 | String lf (paux nm nm n m s1 s). 72 | -------------------------------------------------------------------------------- /theories/Tactic.v: -------------------------------------------------------------------------------- 1 | (* This program is free software; you can redistribute it and/or *) 2 | (* modify it under the terms of the GNU Lesser General Public License *) 3 | (* as published by the Free Software Foundation; either version 2.1 *) 4 | (* of the License, or (at your option) any later version. *) 5 | (* *) 6 | (* This program is distributed in the hope that it will be useful, *) 7 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 8 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 9 | (* GNU General Public License for more details. *) 10 | (* *) 11 | (* You should have received a copy of the GNU Lesser General Public *) 12 | (* License along with this program; if not, write to the Free *) 13 | (* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *) 14 | (* 02110-1301 USA *) 15 | 16 | 17 | 18 | (********************************************************************** 19 | Tactic.v 20 | 21 | Useful tactics 22 | 23 | 24 | Laurent.Thery@inria.fr (2006) 25 | **********************************************************************) 26 | 27 | 28 | (************************************** 29 | A tactic for proof by contradiction 30 | with contradict H 31 | H: ~A |- B gives |- A 32 | H: ~A |- ~ B gives H: B |- A 33 | H: A |- B gives |- ~ A 34 | H: A |- B gives |- ~ A 35 | H: A |- ~ B gives H: A |- ~ A 36 | **************************************) 37 | 38 | Ltac contradict name := 39 | let term := type of name in ( 40 | match term with 41 | (~_) => 42 | match goal with 43 | |- ~ _ => let x := fresh in 44 | (intros x; case name; 45 | generalize x; clear x name; 46 | intro name) 47 | | |- _ => case name; clear name 48 | end 49 | | _ => 50 | match goal with 51 | |- ~ _ => let x := fresh in 52 | (intros x; absurd term; 53 | [idtac | exact name]; generalize x; clear x name; 54 | intros name) 55 | | |- _ => generalize name; absurd term; 56 | [idtac | exact name]; clear name 57 | end 58 | end). 59 | 60 | 61 | (************************************** 62 | A tactic to do case analysis keeping the equality 63 | **************************************) 64 | 65 | Ltac case_eq name := 66 | generalize (refl_equal name); pattern name at -1 in |- *; case name. 67 | -------------------------------------------------------------------------------- /theories/Test.v: -------------------------------------------------------------------------------- 1 | (* This program is free software; you can redistribute it and/or *) 2 | (* modify it under the terms of the GNU Lesser General Public License *) 3 | (* as published by the Free Software Foundation; either version 2.1 *) 4 | (* of the License, or (at your option) any later version. *) 5 | (* *) 6 | (* This program is distributed in the hope that it will be useful, *) 7 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 8 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 9 | (* GNU General Public License for more details. *) 10 | (* *) 11 | (* You should have received a copy of the GNU Lesser General Public *) 12 | (* License along with this program; if not, write to the Free *) 13 | (* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *) 14 | (* 02110-1301 USA *) 15 | 16 | Require Import Sudoku. 17 | Require Import Print. 18 | Require Import String. 19 | Require Import Parse. 20 | Import List. 21 | 22 | Definition one_solution n m l := 23 | match find_one n m l with Some c => print n m c 24 | | _ => "No Solution" end. 25 | 26 | Definition solutions n m l := length (find_all n m l). 27 | 28 | Definition cr := " 29 | ". 30 | 31 | Definition just_one_solution n m l := 32 | match find_just_one n m l with 33 | jOne c => print n m c 34 | | jNone => "No Solution" 35 | | jMore c1 c2 => ("More Than One Solution" ++ cr 36 | ++ (print n m c1) ++ cr ++ (print n m c2))%string 37 | end. 38 | 39 | (* Compute all the sudoku 2 x 2 *) 40 | Eval vm_compute in solutions 2 2 (init 2 2). 41 | 42 | Definition os s := one_solution 3 3 (parse s). 43 | Definition ns s := solutions 3 3 (parse s). 44 | Definition jos s := just_one_solution 3 3 (parse s). 45 | 46 | 47 | Time Eval vm_compute in jos 48 | " 49 | ------------- 50 | | 8|16 |9 | 51 | | 4| 5 |2 | 52 | |97 | 8| 45| 53 | ------------- 54 | | 5| | 6| 55 | |89 | | 37| 56 | |1 | |4 | 57 | ------------- 58 | |36 |5 | 84| 59 | | 2| 7 |5 | 60 | | 7| 49|3 | 61 | -------------". 62 | Definition l1 := Eval vm_compute in parse 63 | " 64 | ------------- 65 | | 8|16 |9 | 66 | | 4| 5 |2 | 67 | |97 | 8| 45| 68 | ------------- 69 | | 5| | 6| 70 | |89 | | 37| 71 | |1 | |4 | 72 | ------------- 73 | |36 |5 | 84| 74 | | 2| 7 |5 | 75 | | 7| 49|3 | 76 | -------------". 77 | 78 | 79 | 80 | Time Eval vm_compute in jos 81 | " 82 | ------------- 83 | | 6|98 |2 | 84 | | | | | 85 | |1 7| 43|8 9| 86 | ------------- 87 | | 2| | 1| 88 | |5 3| |4 7| 89 | |9 | |6 | 90 | ------------- 91 | |2 8|13 |9 5| 92 | | | | | 93 | | 4| 78|1 | 94 | -------------". 95 | 96 | Let ppf n m := one_solution n m (init n m). 97 | 98 | (* Find a solution for 1 x 1 *) 99 | Time Eval compute in (ppf 1 1). 100 | 101 | (* Find a solution for 2 x 1 *) 102 | Time Eval vm_compute in ppf 2 1. 103 | 104 | (* Find a solution for 2 x 2 *) 105 | Time Eval vm_compute in ppf 2 2. 106 | 107 | (* Find a solution for 3 x 2 *) 108 | Time Eval vm_compute in ppf 3 2. 109 | 110 | (* Find a solution for 3 x 3 *) 111 | Time Eval vm_compute in ppf 3 3. 112 | 113 | 114 | (* A problem with more than one solution *) 115 | Time Eval vm_compute in jos 116 | " 117 | ------------- 118 | | |9 | 1| 119 | | | 4 | 2 | 120 | | 8 | 7 | 6| 121 | ------------- 122 | |2 1|4 | | 123 | | |6 | | 124 | |3 | 1|6 8| 125 | ------------- 126 | |5 | | 8 | 127 | |49 | 5 | | 128 | | | 2| | 129 | -------------". 130 | 131 | Time Eval vm_compute in jos 132 | " 133 | ------------- 134 | |5 | | | 135 | | 4 |81 | | 136 | | 93| | 2| 137 | ------------- 138 | | | |2 3| 139 | |9 |7 | | 140 | |23 | 6| 7 | 141 | ------------- 142 | |365|1 | | 143 | | | 5 |8 | 144 | | 1| 7 |6 | 145 | -------------". 146 | 147 | Time Eval vm_compute in jos 148 | 149 | " 150 | ------------- 151 | | | | 6 | 152 | |43 | 5 | 2| 153 | | 7|832|4 | 154 | ------------- 155 | |2 | 43| | 156 | | 81| |34 | 157 | | |68 | 1| 158 | ------------- 159 | | 3|719|6 | 160 | |7 | 6 | 14| 161 | | 6 | | | 162 | -------------". 163 | 164 | (* L'escargot *) 165 | 166 | Time Eval vm_compute in jos 167 | " 168 | ------------- 169 | |1 | 7| 9 | 170 | | 3 | 2 | 8| 171 | | 9|6 |5 | 172 | ------------- 173 | | 5|3 |9 | 174 | | 1 | 8 | 2| 175 | |6 | 4| | 176 | ------------- 177 | |3 | | 1 | 178 | | 4 | | 7| 179 | | 7| |3 | 180 | -------------". 181 | 182 | (* Le Monde 4/3/07 *) 183 | 184 | Time Eval vm_compute in jos 185 | 186 | " 187 | ------------- 188 | |2 | 68| | 189 | | 69| | | 190 | | 7|1 |93 | 191 | ------------- 192 | | | |8 | 193 | |9 |8 |5 | 194 | |35 | | 4 | 195 | ------------- 196 | | 12|7 | | 197 | | | 2 |6 5| 198 | | 5| |4 | 199 | -------------". 200 | 201 | (* Le monde 28/10/07 *) 202 | 203 | Time Eval vm_compute in jos 204 | " 205 | ------------- 206 | |9 | 8| | 207 | | 52| | 1| 208 | | 4| 6 | 3 | 209 | ------------- 210 | | | | | 211 | |2 |1 |6 | 212 | |69 | 32| 1 | 213 | ------------- 214 | | 7|5 | | 215 | | | |8 | 216 | | 6| 93|5 | 217 | -------------". 218 | 219 | (* Repubblica 6/05/2008 *) 220 | 221 | 222 | Time Eval vm_compute in jos 223 | " 224 | ------------- 225 | | |7 |5 | 226 | | | 63| | 227 | | 8 | 2| 1| 228 | ------------- 229 | | 6| 4|2 | 230 | |24 |856| 79| 231 | | 3|2 |1 | 232 | ------------- 233 | |7 |3 | 4 | 234 | | |91 | | 235 | | 2| 8| | 236 | -------------". 237 | 238 | 239 | (* TeleStar 12/05/2008 *) 240 | 241 | 242 | Time Eval vm_compute in jos 243 | " 244 | ------------- 245 | | 2| 3| 9 | 246 | |9 |52 | | 247 | | 3| 8 |4 | 248 | ------------- 249 | | | |18 | 250 | |7 | | 3| 251 | | 54| 6| | 252 | ------------- 253 | | 1| 6 |2 8| 254 | | | 42| 1 | 255 | | 2 |3 | 7 | 256 | -------------". 257 | 258 | (* Le monde 7/10/2008 *) 259 | 260 | 261 | Time Eval vm_compute in jos 262 | " 263 | ------------- 264 | |5 | 37|1 | 265 | | | | | 266 | | 16|2 |4 8| 267 | ------------- 268 | | | | | 269 | | |5 |6 | 270 | |49 | 6| 35| 271 | ------------- 272 | | 87| | | 273 | | 5 |38 | 6| 274 | | 3| 72|8 | 275 | -------------". 276 | -------------------------------------------------------------------------------- /theories/UList.v: -------------------------------------------------------------------------------- 1 | (* This program is free software; you can redistribute it and/or *) 2 | (* modify it under the terms of the GNU Lesser General Public License *) 3 | (* as published by the Free Software Foundation; either version 2.1 *) 4 | (* of the License, or (at your option) any later version. *) 5 | (* *) 6 | (* This program is distributed in the hope that it will be useful, *) 7 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 8 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 9 | (* GNU General Public License for more details. *) 10 | (* *) 11 | (* You should have received a copy of the GNU Lesser General Public *) 12 | (* License along with this program; if not, write to the Free *) 13 | (* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *) 14 | (* 02110-1301 USA *) 15 | 16 | 17 | (*********************************************************************** 18 | UList.v 19 | 20 | Definition of list with distinct elements 21 | 22 | Definition: ulist 23 | 24 | Laurent.Thery@inria.fr (2006) 25 | ************************************************************************) 26 | Require Import List. 27 | Require Import Arith. 28 | Require Import Permutation. 29 | Require Import ListSet. 30 | 31 | Section UniqueList. 32 | Variable A : Set. 33 | Variable eqA_dec : forall (a b : A), ({ a = b }) + ({ a <> b }). 34 | (* A list is unique if there is not twice the same element in the list *) 35 | 36 | Definition ulist (l1 : list A) := NoDup l1. 37 | Definition ulist_nil := NoDup_nil. 38 | Definition ulist_cons a l (H : ~ In a l) (H1 : ulist l) := NoDup_cons a H H1. 39 | Hint Unfold ulist : core. 40 | Hint Constructors NoDup : core. 41 | 42 | (* Inversion theorem *) 43 | 44 | Theorem ulist_inv: forall a l, ulist (a :: l) -> ulist l. 45 | intros a l H; inversion H; auto. 46 | Qed. 47 | (* The append of two unique list is unique if the list are distinct *) 48 | 49 | Theorem ulist_app: 50 | forall l1 l2, 51 | ulist l1 -> 52 | ulist l2 -> (forall (a : A), In a l1 -> In a l2 -> False) -> ulist (l1 ++ l2). 53 | intros L1; elim L1; simpl; auto. 54 | intros a l H l2 H0 H1 H2; apply NoDup_cons; simpl; auto. 55 | red; intros H3; case in_app_or with ( 1 := H3 ); auto; intros H4. 56 | inversion H0; auto. 57 | apply H2 with a; auto. 58 | apply H; auto. 59 | apply ulist_inv with ( 1 := H0 ); auto. 60 | intros a0 H3 H4; apply (H2 a0); auto. 61 | Qed. 62 | (* Iinversion theorem the appended list *) 63 | 64 | Theorem ulist_app_inv: 65 | forall l1 l2 (a : A), ulist (l1 ++ l2) -> In a l1 -> In a l2 -> False. 66 | intros l1; elim l1; simpl; auto. 67 | intros a l H l2 a0 H0 [H1|H1] H2. 68 | inversion H0 as [|a1 l0 H3 H4 H5]; auto. 69 | case H3; rewrite H1; auto with datatypes. 70 | apply (H l2 a0); auto. 71 | apply ulist_inv with ( 1 := H0 ); auto. 72 | Qed. 73 | (* Iinversion theorem the appended list *) 74 | 75 | Theorem ulist_app_inv_l: forall (l1 l2 : list A), ulist (l1 ++ l2) -> ulist l1. 76 | Proof. 77 | intros l1 l2. 78 | generalize dependent l1. 79 | induction l2; intros l1 H. 80 | - rewrite app_nil_r in H. assumption. 81 | - apply NoDup_remove_1 in H; auto. 82 | Qed. 83 | (* Iinversion theorem the appended list *) 84 | 85 | Theorem ulist_app_inv_r: forall (l1 l2 : list A), ulist (l1 ++ l2) -> ulist l2. 86 | intros l1; elim l1; simpl; auto. 87 | intros a l H l2 H0; inversion H0; auto. 88 | Qed. 89 | (* Uniqueness is decidable *) 90 | 91 | Definition ulist_dec: forall l, ({ ulist l }) + ({ ~ ulist l }). 92 | Proof. 93 | apply ListDec.NoDup_dec; auto. 94 | Defined. 95 | (* Uniqueness is compatible with permutation *) 96 | 97 | Theorem ulist_perm: 98 | forall (l1 l2 : list A), Permutation l1 l2 -> ulist l1 -> ulist l2. 99 | Proof. 100 | apply Permutation_NoDup. 101 | Qed. 102 | 103 | Theorem ulist_def: 104 | forall l a, 105 | In a l -> ulist l -> ~ (exists l1 , Permutation l (a :: (a :: l1)) ). 106 | intros l a H H0 [l1 H1]. 107 | absurd (ulist (a :: (a :: l1))); auto. 108 | intros H2; inversion_clear H2; simpl; auto with datatypes. 109 | apply ulist_perm with ( 1 := H1 ); auto. 110 | Qed. 111 | 112 | Theorem ulist_incl_permutation: 113 | forall (l1 l2 : list A), 114 | ulist l1 -> incl l1 l2 -> (exists l3 , Permutation l2 (l1 ++ l3) ). 115 | Proof with auto with datatypes. 116 | intros l1; elim l1; simpl... 117 | intros l2 H H0; exists l2; simpl... 118 | intros a l H l2 H0 H1... 119 | case (in_permutation_ex _ a l2)... 120 | intros l3 Hl3. 121 | case (H l3)... 122 | apply ulist_inv with ( 1 := H0 )... 123 | intros b Hb. 124 | assert (H2: In b (a :: l3)). 125 | apply Permutation_in with ( 1 := Permutation_sym Hl3 )... 126 | simpl in H2 |-; case H2; intros H3; simpl... 127 | inversion_clear H0 as [|c lc Hk1]... 128 | case Hk1; subst a... 129 | intros l4 H4; exists l4. 130 | apply perm_trans with (a :: l3)... 131 | apply Permutation_sym... 132 | Qed. 133 | 134 | Theorem ulist_eq_permutation: 135 | forall (l1 l2 : list A), 136 | ulist l1 -> incl l1 l2 -> length l1 = length l2 -> Permutation l1 l2. 137 | Proof with auto with arith. 138 | intros l1 l2 H1 H2 H3. 139 | case (ulist_incl_permutation l1 l2)... 140 | intros l3 H4. 141 | assert (H5: l3 = @nil A). 142 | generalize (Permutation_length H4); rewrite app_length, H3. 143 | rewrite Nat.add_comm; case l3; simpl... 144 | intros a l H5; absurd (lt (length l2) (length l2))... 145 | pattern (length l2) at 2; rewrite H5... 146 | replace l1 with (app l1 l3)... 147 | apply Permutation_sym... 148 | rewrite H5, app_nil_end... 149 | Qed. 150 | 151 | 152 | Theorem ulist_incl_length: 153 | forall (l1 l2 : list A), ulist l1 -> incl l1 l2 -> le (length l1) (length l2). 154 | intros l1 l2 H1 Hi; case ulist_incl_permutation with ( 2 := Hi ); auto. 155 | intros l3 Hl3; rewrite Permutation_length with ( 1 := Hl3 ); auto. 156 | rewrite app_length; simpl; auto with arith. 157 | Qed. 158 | 159 | Theorem ulist_incl2_permutation: 160 | forall (l1 l2 : list A), 161 | ulist l1 -> ulist l2 -> incl l1 l2 -> incl l2 l1 -> Permutation l1 l2. 162 | intros l1 l2 H1 H2 H3 H4. 163 | apply ulist_eq_permutation; auto. 164 | apply Nat.le_antisymm; apply ulist_incl_length; auto. 165 | Qed. 166 | 167 | 168 | Theorem ulist_incl_length_strict: 169 | forall (l1 l2 : list A), 170 | ulist l1 -> incl l1 l2 -> ~ incl l2 l1 -> lt (length l1) (length l2). 171 | Proof with auto with arith. 172 | intros l1 l2 H1 Hi Hi0; case ulist_incl_permutation with ( 2 := Hi )... 173 | intros l3 Hl3; rewrite Permutation_length with ( 1 := Hl3 )... 174 | rewrite app_length; simpl... 175 | generalize Hl3; case l3; simpl... 176 | rewrite <- app_nil_end... 177 | intros H2; case Hi0... 178 | intros a HH; apply Permutation_in with ( 1 := H2 )... 179 | intros a l Hl0; (rewrite Nat.add_comm; simpl; rewrite Nat.add_comm; auto with arith). 180 | Qed. 181 | 182 | Theorem in_inv_dec: 183 | forall (a b : A) l, In a (cons b l) -> a = b \/ ~ a = b /\ In a l. 184 | intros a b l H; case (eqA_dec a b); auto; intros H1. 185 | right; split; auto; inversion H; auto. 186 | case H1; auto. 187 | Qed. 188 | 189 | Theorem in_ex_app_first: 190 | forall (a : A) (l : list A), 191 | In a l -> 192 | (exists l1 : list A , exists l2 : list A , l = l1 ++ (a :: l2) /\ ~ In a l1 ). 193 | intros a l; elim l; clear l; auto. 194 | intros H; case H. 195 | intros a1 l H H1; auto. 196 | generalize (in_inv_dec _ _ _ H1); intros [H2|[H2 H3]]. 197 | exists (nil (A:=A)); exists l; simpl; split; auto. 198 | f_equal; auto. 199 | case H; auto; intros l1 [l2 [Hl2 Hl3]]; exists (a1 :: l1); exists l2; simpl; 200 | split; auto. 201 | f_equal; auto. 202 | intros H4; case H4; auto. 203 | Qed. 204 | 205 | Theorem nth_ulist: forall a i j (l: list A), i < length l -> j < length l -> 206 | ulist l -> nth i l a = nth j l a -> i = j. 207 | intros a i j l; generalize i j; elim l; simpl; clear l i j. 208 | intros i j H; contradict H; auto with arith. 209 | intros b l1 Rec i j; case i; case j; auto with arith; clear i j. 210 | intros j _ H1 H2 H3; absurd (In b l1); auto. 211 | inversion H2; auto. 212 | subst; apply nth_In; auto with arith. 213 | intros i H1 _ H2 H3; absurd (In b l1); auto. 214 | inversion H2; auto. 215 | subst; apply nth_In; auto with arith. 216 | intros j i H1 H2 H3 H4; inversion H3; auto with arith. 217 | Qed. 218 | 219 | End UniqueList. 220 | 221 | Arguments ulist [A]. 222 | Global Hint Unfold ulist : core. 223 | Global Hint Constructors NoDup : core. 224 | 225 | Theorem ulist_map: 226 | forall (A B : Set) (f : A -> B) l, 227 | (forall x y, (In x l) -> (In y l) -> f x = f y -> x = y) -> ulist l -> ulist (map f l). 228 | Proof. 229 | intros a b f l Hf Hl; generalize Hf; elim Hl; clear Hf; auto. 230 | simpl; auto. 231 | intros a1 l1 H1 H2 H3 Hf; simpl. 232 | apply ulist_cons; auto with datatypes. 233 | contradict H1. 234 | case in_map_inv with ( 1 := H1 ); auto. 235 | intros b1 [Hb1 Hb2]. 236 | replace a1 with b1; auto with datatypes. 237 | Qed. 238 | 239 | Theorem ulist_list_prod: 240 | forall (A : Set) (l1 l2 : list A), 241 | ulist l1 -> ulist l2 -> ulist (list_prod l1 l2). 242 | Proof with auto. 243 | intros A l1 l2 Hl1 Hl2; elim Hl1; simpl... 244 | intros a l H1 H2 H3; apply ulist_app... 245 | apply ulist_map... 246 | intros x y _ _ H; inversion H... 247 | intros p Hp1 Hp2; case H1. 248 | case in_map_inv with ( 1 := Hp1 ); intros a1 [Ha1 Ha2]... 249 | case in_list_prod_inv with ( 1 := Hp2 ); intros b1 [c1 [Hb1 [Hb2 Hb3]]]... 250 | replace a with b1... 251 | rewrite Ha2 in Hb1; injection Hb1... 252 | Qed. 253 | -------------------------------------------------------------------------------- /theories/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name Sudoku) 3 | (package coq-sudoku) 4 | (synopsis "Sudoku solver certified in Coq")) 5 | --------------------------------------------------------------------------------